Released DVBA*2.7*179 SEQ #158 Extracted from mail message **KIDS**:DVBA*2.7*179^ **INSTALL NAME** DVBA*2.7*179 "BLD",8305,0) DVBA*2.7*179^AUTOMATED MED INFO EXCHANGE^0^3120524^y "BLD",8305,1,0) ^^1^1^3120314^ "BLD",8305,1,1,0) Please see FORUM for a more complete description of DVBA*2.7*179. "BLD",8305,4,0) ^9.64PA^396.3^1 "BLD",8305,4,396.3,0) 396.3 "BLD",8305,4,396.3,2,0) ^9.641^396.3^1 "BLD",8305,4,396.3,2,396.3,0) 2507 REQUEST (File-top level) "BLD",8305,4,396.3,2,396.3,1,0) ^9.6411^17^2 "BLD",8305,4,396.3,2,396.3,1,7,0) DATE STATUS LAST CHANGED "BLD",8305,4,396.3,2,396.3,1,17,0) REQUEST STATUS "BLD",8305,4,396.3,222) y^n^p^^^^n^^n "BLD",8305,4,396.3,224) "BLD",8305,4,"APDD",396.3,396.3) "BLD",8305,4,"APDD",396.3,396.3,7) "BLD",8305,4,"APDD",396.3,396.3,17) "BLD",8305,4,"B",396.3,396.3) "BLD",8305,6) 1^ "BLD",8305,6.3) 15 "BLD",8305,"ABPKG") n "BLD",8305,"INIT") POST^DVBA179P "BLD",8305,"KRN",0) ^9.67PA^779.2^20 "BLD",8305,"KRN",.4,0) .4 "BLD",8305,"KRN",.401,0) .401 "BLD",8305,"KRN",.402,0) .402 "BLD",8305,"KRN",.403,0) .403 "BLD",8305,"KRN",.5,0) .5 "BLD",8305,"KRN",.84,0) .84 "BLD",8305,"KRN",3.6,0) 3.6 "BLD",8305,"KRN",3.8,0) 3.8 "BLD",8305,"KRN",9.2,0) 9.2 "BLD",8305,"KRN",9.8,0) 9.8 "BLD",8305,"KRN",9.8,"NM",0) ^9.68A^8^8 "BLD",8305,"KRN",9.8,"NM",1,0) DVBAB1^^0^B100042303 "BLD",8305,"KRN",9.8,"NM",2,0) DVBARSBD^^0^B41501602 "BLD",8305,"KRN",9.8,"NM",3,0) DVBAB82^^0^B109260107 "BLD",8305,"KRN",9.8,"NM",4,0) DVBAB51^^0^B51087227 "BLD",8305,"KRN",9.8,"NM",5,0) DVBAB53^^0^B51879016 "BLD",8305,"KRN",9.8,"NM",6,0) DVBAB54^^0^B35153355 "BLD",8305,"KRN",9.8,"NM",7,0) DVBAB56^^0^B25277073 "BLD",8305,"KRN",9.8,"NM",8,0) DVBAB98^^0^B34547501 "BLD",8305,"KRN",9.8,"NM","B","DVBAB1",1) "BLD",8305,"KRN",9.8,"NM","B","DVBAB51",4) "BLD",8305,"KRN",9.8,"NM","B","DVBAB53",5) "BLD",8305,"KRN",9.8,"NM","B","DVBAB54",6) "BLD",8305,"KRN",9.8,"NM","B","DVBAB56",7) "BLD",8305,"KRN",9.8,"NM","B","DVBAB82",3) "BLD",8305,"KRN",9.8,"NM","B","DVBAB98",8) "BLD",8305,"KRN",9.8,"NM","B","DVBARSBD",2) "BLD",8305,"KRN",19,0) 19 "BLD",8305,"KRN",19,"NM",0) ^9.68A^^ "BLD",8305,"KRN",19.1,0) 19.1 "BLD",8305,"KRN",101,0) 101 "BLD",8305,"KRN",409.61,0) 409.61 "BLD",8305,"KRN",771,0) 771 "BLD",8305,"KRN",779.2,0) 779.2 "BLD",8305,"KRN",870,0) 870 "BLD",8305,"KRN",8989.51,0) 8989.51 "BLD",8305,"KRN",8989.52,0) 8989.52 "BLD",8305,"KRN",8994,0) 8994 "BLD",8305,"KRN",8994,"NM",0) ^9.68A^5^5 "BLD",8305,"KRN",8994,"NM",1,0) DVBAB SEND MSG^^0 "BLD",8305,"KRN",8994,"NM",2,0) DVBAB REPORT ADMISSIONS^^0 "BLD",8305,"KRN",8994,"NM",3,0) DVBAB REPORT DISCHARGE^^0 "BLD",8305,"KRN",8994,"NM",4,0) DVBAB REPORT INCOMPVET^^0 "BLD",8305,"KRN",8994,"NM",5,0) DVBAB REPORT READMIT^^0 "BLD",8305,"KRN",8994,"NM","B","DVBAB REPORT ADMISSIONS",2) "BLD",8305,"KRN",8994,"NM","B","DVBAB REPORT DISCHARGE",3) "BLD",8305,"KRN",8994,"NM","B","DVBAB REPORT INCOMPVET",4) "BLD",8305,"KRN",8994,"NM","B","DVBAB REPORT READMIT",5) "BLD",8305,"KRN",8994,"NM","B","DVBAB SEND MSG",1) "BLD",8305,"KRN","B",.4,.4) "BLD",8305,"KRN","B",.401,.401) "BLD",8305,"KRN","B",.402,.402) "BLD",8305,"KRN","B",.403,.403) "BLD",8305,"KRN","B",.5,.5) "BLD",8305,"KRN","B",.84,.84) "BLD",8305,"KRN","B",3.6,3.6) "BLD",8305,"KRN","B",3.8,3.8) "BLD",8305,"KRN","B",9.2,9.2) "BLD",8305,"KRN","B",9.8,9.8) "BLD",8305,"KRN","B",19,19) "BLD",8305,"KRN","B",19.1,19.1) "BLD",8305,"KRN","B",101,101) "BLD",8305,"KRN","B",409.61,409.61) "BLD",8305,"KRN","B",771,771) "BLD",8305,"KRN","B",779.2,779.2) "BLD",8305,"KRN","B",870,870) "BLD",8305,"KRN","B",8989.51,8989.51) "BLD",8305,"KRN","B",8989.52,8989.52) "BLD",8305,"KRN","B",8994,8994) "BLD",8305,"QDEF") ^^^^NO^^^^NO^^NO "BLD",8305,"QUES",0) ^9.62^^ "BLD",8305,"REQB",0) ^9.611^3^3 "BLD",8305,"REQB",1,0) PSO*7.0*382^2 "BLD",8305,"REQB",2,0) DVBA*2.7*148^2 "BLD",8305,"REQB",3,0) DVBA*2.7*149^2 "BLD",8305,"REQB","B","DVBA*2.7*148",2) "BLD",8305,"REQB","B","DVBA*2.7*149",3) "BLD",8305,"REQB","B","PSO*7.0*382",1) "FIA",396.3) 2507 REQUEST "FIA",396.3,0) ^DVB(396.3, "FIA",396.3,0,0) 396.3IP "FIA",396.3,0,1) y^n^p^^^^n^^n "FIA",396.3,0,10) "FIA",396.3,0,11) "FIA",396.3,0,"RLRO") "FIA",396.3,0,"VR") 2.7^DVBA "FIA",396.3,396.3) 1 "FIA",396.3,396.3,7) "FIA",396.3,396.3,17) "INIT") POST^DVBA179P "KRN",8994,738,-1) 0^1 "KRN",8994,738,0) DVBAB SEND MSG^MSG^DVBAB1^1^S "KRN",8994,738,1,0) ^8994.01^2^2^3120112^^ "KRN",8994,738,1,1,0) Used to generate e-mail messages for specific CAPRI actions, such as "KRN",8994,738,1,2,0) changing a C&P exam request. "KRN",8994,738,2,0) ^8994.02A^5^5 "KRN",8994,738,2,1,0) VAL1^1^8^1 "KRN",8994,738,2,1,1,0) ^^1^1^3000215^ "KRN",8994,738,2,1,1,1,0) This is the cancelling users DUZ. "KRN",8994,738,2,2,0) VAL2^1^45^1 "KRN",8994,738,2,2,1,0) ^^1^1^3000215^ "KRN",8994,738,2,2,1,1,0) This is the Subjecto of the message - XMSUB "KRN",8994,738,2,3,0) VAL3^2^^1 "KRN",8994,738,2,3,1,0) ^^1^1^3000216^^^^ "KRN",8994,738,2,3,1,1,0) This is the text of the message - XMTEXT "KRN",8994,738,2,4,0) VAL4^1^30^1 "KRN",8994,738,2,4,1,0) ^^1^1^3000216^^ "KRN",8994,738,2,4,1,1,0) This is the mail group name - MGN "KRN",8994,738,2,5,0) VAL5^1^15^0 "KRN",8994,738,2,5,1,0) ^8994.021^1^1^3120112^^ "KRN",8994,738,2,5,1,1,0) This is the 2507 request number "KRN",8994,738,2,"B","VAL1",1) "KRN",8994,738,2,"B","VAL2",2) "KRN",8994,738,2,"B","VAL3",3) "KRN",8994,738,2,"B","VAL4",4) "KRN",8994,738,2,"B","VAL5",5) "KRN",8994,752,-1) 0^4 "KRN",8994,752,0) DVBAB REPORT INCOMPVET^STRT^DVBAB51^4^R^0^^1 "KRN",8994,752,1,0) ^8994.01^2^2^3120216^^ "KRN",8994,752,1,1,0) Generates an incompetent veteran report, in either standard or delimited "KRN",8994,752,1,2,0) format, for the specificed date range. "KRN",8994,752,2,0) ^8994.02A^3^3 "KRN",8994,752,2,1,0) BDATE^1^^1^1 "KRN",8994,752,2,1,1,0) ^^2^2^3101006^ "KRN",8994,752,2,1,1,1,0) Beginning date in a date range to use for retrieving results for the "KRN",8994,752,2,1,1,2,0) report. "KRN",8994,752,2,2,0) EDATE^1^^1^2 "KRN",8994,752,2,2,1,0) ^^1^1^3101006^ "KRN",8994,752,2,2,1,1,0) Ending date in a date range to use for retrieving results for the report. "KRN",8994,752,2,3,0) DVBADLMTR^1^^0^3 "KRN",8994,752,2,3,1,0) ^8994.021^3^3^3120216^^ "KRN",8994,752,2,3,1,1,0) This is an optional parameter, which when defined with the final end date "KRN",8994,752,2,3,1,2,0) selected in the GUI, will produce a delimited report. If this parameter "KRN",8994,752,2,3,1,3,0) is undefined, null or 0 then the standard report format will be generated. "KRN",8994,752,2,"B","BDATE",1) "KRN",8994,752,2,"B","DVBADLMTR",3) "KRN",8994,752,2,"B","EDATE",2) "KRN",8994,752,2,"PARAMSEQ",1,1) "KRN",8994,752,2,"PARAMSEQ",2,2) "KRN",8994,752,2,"PARAMSEQ",3,3) "KRN",8994,753,-1) 0^3 "KRN",8994,753,0) DVBAB REPORT DISCHARGE^STRT^DVBAB53^4^R^0^^1 "KRN",8994,753,1,0) ^8994.01^2^2^3120215^^ "KRN",8994,753,1,1,0) Generates a discharge report, in either standard or delimited format, for "KRN",8994,753,1,2,0) the specified parameters. "KRN",8994,753,2,0) ^8994.02A^4^4 "KRN",8994,753,2,1,0) BDATE^1^^1^1 "KRN",8994,753,2,1,1,0) ^^2^2^3101006^ "KRN",8994,753,2,1,1,1,0) Beginning date in a date range to use for retrieving results for the "KRN",8994,753,2,1,1,2,0) report. "KRN",8994,753,2,2,0) EDATE^1^^1^2 "KRN",8994,753,2,2,1,0) ^^1^1^3101006^ "KRN",8994,753,2,2,1,1,0) Ending date in a date range to use for retrieving results for the report. "KRN",8994,753,2,3,0) ADTYPE^1^^1^3 "KRN",8994,753,2,3,1,0) ^^5^5^3101006^ "KRN",8994,753,2,3,1,1,0) Valid discharge code values: "KRN",8994,753,2,3,1,2,0) 'A' - Recieving A&A "KRN",8994,753,2,3,1,3,0) 'P' - Pension "KRN",8994,753,2,3,1,4,0) 'S' - Service Connected "KRN",8994,753,2,3,1,5,0) 'L' - All discharge types "KRN",8994,753,2,4,0) DVBADLMTR^1^^0^4 "KRN",8994,753,2,4,1,0) ^8994.021^3^3^3120215^^ "KRN",8994,753,2,4,1,1,0) This is an optional parameter, which when defined with the final end date "KRN",8994,753,2,4,1,2,0) selected in the GUI, will produce a delimited report. If this parameter "KRN",8994,753,2,4,1,3,0) is undefined, null or 0 then the standard report format will be generated. "KRN",8994,753,2,"B","ADTYPE",3) "KRN",8994,753,2,"B","BDATE",1) "KRN",8994,753,2,"B","DVBADLMTR",4) "KRN",8994,753,2,"B","EDATE",2) "KRN",8994,753,2,"PARAMSEQ",1,1) "KRN",8994,753,2,"PARAMSEQ",2,2) "KRN",8994,753,2,"PARAMSEQ",3,3) "KRN",8994,753,2,"PARAMSEQ",4,4) "KRN",8994,754,-1) 0^5 "KRN",8994,754,0) DVBAB REPORT READMIT^STRT^DVBAB56^4^R^0^^1 "KRN",8994,754,1,0) ^8994.01^2^2^3120307^^^^ "KRN",8994,754,1,1,0) Generates a re-admission report, in either standard or delimited format, "KRN",8994,754,1,2,0) for the specified date range. "KRN",8994,754,2,0) ^8994.02A^4^4 "KRN",8994,754,2,1,0) BDATE^1^^1^1 "KRN",8994,754,2,1,1,0) ^^2^2^3101006^ "KRN",8994,754,2,1,1,1,0) Beginning date in a date range to use for retrieving results for the "KRN",8994,754,2,1,1,2,0) report. "KRN",8994,754,2,2,0) EDATE^1^^1^2 "KRN",8994,754,2,2,1,0) ^^1^1^3101006^ "KRN",8994,754,2,2,1,1,0) Ending date in a date range to use for retrieving results for the report. "KRN",8994,754,2,3,0) DVBAH^1^^1^3 "KRN",8994,754,2,3,1,0) ^^3^3^3101006^ "KRN",8994,754,2,3,1,1,0) Defines the scope of the report: "KRN",8994,754,2,3,1,2,0) 'H' indicates HOSPITAL "KRN",8994,754,2,3,1,3,0) 'D' indicates DOM "KRN",8994,754,2,4,0) DVBADLMTR^1^^0^4 "KRN",8994,754,2,4,1,0) ^8994.021^3^3^3120307^^^^ "KRN",8994,754,2,4,1,1,0) This is an optional parameter, which when defined with the final end date "KRN",8994,754,2,4,1,2,0) selected in the GUI, will produce a delimited report. If this parameter "KRN",8994,754,2,4,1,3,0) is undefined, null or 0 then the standard report format will be generated. "KRN",8994,754,2,"B","BDATE",1) "KRN",8994,754,2,"B","DVBADLMTR",4) "KRN",8994,754,2,"B","DVBAH",3) "KRN",8994,754,2,"B","EDATE",2) "KRN",8994,754,2,"PARAMSEQ",1,1) "KRN",8994,754,2,"PARAMSEQ",2,2) "KRN",8994,754,2,"PARAMSEQ",3,3) "KRN",8994,754,2,"PARAMSEQ",4,4) "KRN",8994,755,-1) 0^2 "KRN",8994,755,0) DVBAB REPORT ADMISSIONS^STRT^DVBAB54^4^R^0^^1 "KRN",8994,755,1,0) ^8994.01^2^2^3101006^^^ "KRN",8994,755,1,1,0) Generates an admission report, in either standard or delimited format, "KRN",8994,755,1,2,0) for the specified date range. "KRN",8994,755,2,0) ^8994.02A^3^3 "KRN",8994,755,2,1,0) BDATE^1^^1^1 "KRN",8994,755,2,1,1,0) ^8994.021^2^2^3101006^^ "KRN",8994,755,2,1,1,1,0) Beginning date in a date range to use for retrieving results for the "KRN",8994,755,2,1,1,2,0) report. "KRN",8994,755,2,2,0) EDATE^1^^1^2 "KRN",8994,755,2,2,1,0) ^8994.021^1^1^3101006^^ "KRN",8994,755,2,2,1,1,0) Ending date in a date range to use for retrieving results for the report. "KRN",8994,755,2,3,0) DVBADLMTR^1^^0^3 "KRN",8994,755,2,3,1,0) ^8994.021^3^3^3101006^^ "KRN",8994,755,2,3,1,1,0) This is an optional parameter, which when defined with the final end date "KRN",8994,755,2,3,1,2,0) selected in the GUI, will produce a delimited report. If this parameter "KRN",8994,755,2,3,1,3,0) is undefined, null or 0 then the standard report format will be generated. "KRN",8994,755,2,"B","BDATE",1) "KRN",8994,755,2,"B","DVBADLMTR",3) "KRN",8994,755,2,"B","EDATE",2) "KRN",8994,755,2,"PARAMSEQ",1,1) "KRN",8994,755,2,"PARAMSEQ",2,2) "KRN",8994,755,2,"PARAMSEQ",3,3) "MBREQ") 0 "ORD",16,8994) 8994;16;1;;;;;;;RPCDEL^XPDIA1 "ORD",16,8994,0) REMOTE PROCEDURE "PKG",223,-1) 1^1 "PKG",223,0) AUTOMATED MED INFO EXCHANGE^DVBA^The entire AMIE package 7131/2507. "PKG",223,20,0) ^9.402P^^ "PKG",223,22,0) ^9.49I^1^1 "PKG",223,22,1,0) 2.7^2950410^3010328 "PKG",223,22,1,"PAH",1,0) 179^3120524^11744 "PKG",223,22,1,"PAH",1,1,0) ^^1^1^3120524 "PKG",223,22,1,"PAH",1,1,1,0) Please see FORUM for a more complete description of DVBA*2.7*179. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 9 "RTN","DVBA179P") 0^^B30688582^n/a "RTN","DVBA179P",1,0) DVBA179P ;ALB/EF - Post init for DVBA*2.7*179 ; 1/15/2012 "RTN","DVBA179P",2,0) ;;2.7;AMIE;**179**;Apr 10, 1995;Build 15 "RTN","DVBA179P",3,0) ; "RTN","DVBA179P",4,0) ; The POST1 section of this routine adds menu items to two of the "RTN","DVBA179P",5,0) ; HRC menus distributed in DVBA*2.7*149. "RTN","DVBA179P",6,0) ; The PSO HRC PROFILE/REFILL menu item is included in patch PSO*7*382 "RTN","DVBA179P",7,0) ; See ICR #4595 "RTN","DVBA179P",8,0) ; "RTN","DVBA179P",9,0) ; The POST2 section of this routine collects the last 90 days of records "RTN","DVBA179P",10,0) ; in the 2507 REQUEST (#396.3) file and populates the new "RTN","DVBA179P",11,0) ; DATE STATUS LAST CHANGED (#7) field. "RTN","DVBA179P",12,0) ; "RTN","DVBA179P",13,0) POST ; "RTN","DVBA179P",14,0) ; "RTN","DVBA179P",15,0) D POST1 ;add HRC menu "RTN","DVBA179P",16,0) D POST2 ;populate DATE STATUS LAST CHANGED (#7) field in 2507 REQUEST (#396.3) file. "RTN","DVBA179P",17,0) Q "RTN","DVBA179P",18,0) ; "RTN","DVBA179P",19,0) POST1 ; "RTN","DVBA179P",20,0) ; "RTN","DVBA179P",21,0) ;See ADDMNU for documentation on input parameters. "RTN","DVBA179P",22,0) ;Last parameter is the Display Order. Must be a number from 1 - 99. "RTN","DVBA179P",23,0) ; "RTN","DVBA179P",24,0) ;Pharmacy menu "RTN","DVBA179P",25,0) ; "RTN","DVBA179P",26,0) D BMES^XPDUTL("-> Adding PSO HRC PROFILE/REFILL option to HRC Pharmacy Customer Care Menu <-") "RTN","DVBA179P",27,0) D ADDMNU("DVBA HRC MENU PHARMACY CC","PSO HRC PROFILE/REFILL","PPR",30) "RTN","DVBA179P",28,0) ; "RTN","DVBA179P",29,0) D BMES^XPDUTL("-> Adding PSO HRC PROFILE/REFILL option to HRC Pharmacy Menu <-") "RTN","DVBA179P",30,0) D ADDMNU("DVBA HRC MENU PHARMACY","PSO HRC PROFILE/REFILL","PPR",30) "RTN","DVBA179P",31,0) ; "RTN","DVBA179P",32,0) Q "RTN","DVBA179P",33,0) ADDMNU(DVB1,DVB2,DVB3,DVB4) ; "RTN","DVBA179P",34,0) ; "RTN","DVBA179P",35,0) ;Adds Items to Menu (#19.01) subfile in Option (#19) file "RTN","DVBA179P",36,0) ;Input: "RTN","DVBA179P",37,0) ; DVB1 = Name of the menu(Required) "RTN","DVBA179P",38,0) ; DVB2 = Item (#.01)- Name of Option being added to the menu. (Required) "RTN","DVBA179P",39,0) ; DVB3 = Synonym (#2) field (optional) "RTN","DVBA179P",40,0) ; DVB4 = Display Order (#3) field (optional) (Number from 1 - 99) "RTN","DVBA179P",41,0) ; "RTN","DVBA179P",42,0) ;Output: 1 = Success - Option added to menu. "RTN","DVBA179P",43,0) ; 0 = Failure - Option not added to menu. "RTN","DVBA179P",44,0) ; "RTN","DVBA179P",45,0) N DVOK "RTN","DVBA179P",46,0) S DVOK=$$ADD^XPDMENU(DVB1,DVB2,DVB3,DVB4) "RTN","DVBA179P",47,0) I 'DVOK D Q "RTN","DVBA179P",48,0) .D MES^XPDUTL(" Could not add "_DVB2_" to "_DVB1) "RTN","DVBA179P",49,0) D MES^XPDUTL(" "_DVB2_" added to "_DVB1) "RTN","DVBA179P",50,0) Q "RTN","DVBA179P",51,0) ; "RTN","DVBA179P",52,0) POST2 ;Set up TaskMan to populate new Date field in the background "RTN","DVBA179P",53,0) N ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK "RTN","DVBA179P",54,0) S ZTRTN="SETFLD7^DVBA179P" "RTN","DVBA179P",55,0) S ZTDESC="Populate DATE STATUS LAST CHANGED for DVBA*2.7*179" "RTN","DVBA179P",56,0) ;Queue Task to start in 60 seconds "RTN","DVBA179P",57,0) S ZTDTH=$$SCH^XLFDT("60S",$$NOW^XLFDT) "RTN","DVBA179P",58,0) S ZTIO="" "RTN","DVBA179P",59,0) D ^%ZTLOAD "RTN","DVBA179P",60,0) D BMES^XPDUTL("*****") "RTN","DVBA179P",61,0) D "RTN","DVBA179P",62,0) . I $D(ZTSK)[0 D Q "RTN","DVBA179P",63,0) . .D MES^XPDUTL("TaskMan run to populate new Date field for DVBA*2.7*179 was not started.") "RTN","DVBA179P",64,0) . .D MES^XPDUTL("Re-run Post Install routine POST2^DVBA179P.") "RTN","DVBA179P",65,0) . D MES^XPDUTL("Task "_ZTSK_" started to populate new Date field.") "RTN","DVBA179P",66,0) . I $D(ZTSK("D")) D "RTN","DVBA179P",67,0) . . D MES^XPDUTL("Task will start at "_$$HTE^XLFDT(ZTSK("D"))) "RTN","DVBA179P",68,0) D MES^XPDUTL("*****") "RTN","DVBA179P",69,0) Q "RTN","DVBA179P",70,0) ; "RTN","DVBA179P",71,0) SETFLD7 ; "RTN","DVBA179P",72,0) ; Retrieve 2507 REQUEST (#396.3) record date fields for the last 90 days, "RTN","DVBA179P",73,0) ; determine most recent activity date and populate the DATE STATUS LAST "RTN","DVBA179P",74,0) ; CHANGED (#7) field. "RTN","DVBA179P",75,0) ; "RTN","DVBA179P",76,0) N DVBCNT ;updated record count "RTN","DVBA179P",77,0) N DVBDAT ;2507 REQUEST DATE "RTN","DVBA179P",78,0) N DVBIEN ;2507 REQUEST IEN "RTN","DVBA179P",79,0) N DVBLST ;last activity date "RTN","DVBA179P",80,0) N DVBMSG ;notification text "RTN","DVBA179P",81,0) N DVBQUIT ;stop task "RTN","DVBA179P",82,0) N DVBSTART ;start time "RTN","DVBA179P",83,0) ; "RTN","DVBA179P",84,0) S DVBSTART=$$NOW^XLFDT() "RTN","DVBA179P",85,0) S DVBCNT=0 "RTN","DVBA179P",86,0) S DVBQUIT=0 "RTN","DVBA179P",87,0) S DVBDAT=$$FMADD^XLFDT($$DT^XLFDT(),-91) "RTN","DVBA179P",88,0) F S DVBDAT=$O(^DVB(396.3,"C",DVBDAT)) Q:'DVBDAT!(DVBQUIT) D "RTN","DVBA179P",89,0) . S DVBIEN=0 "RTN","DVBA179P",90,0) . S DVBIEN=$O(^DVB(396.3,"C",DVBDAT,DVBIEN)) Q:'DVBIEN D "RTN","DVBA179P",91,0) . . S DVBLST=$$GETLAST(DVBIEN) "RTN","DVBA179P",92,0) . . I DVBLST,$$SETLAST(DVBIEN,DVBLST) S DVBCNT=DVBCNT+1 "RTN","DVBA179P",93,0) . . ; "RTN","DVBA179P",94,0) . I $$S^%ZTLOAD D Q ;check for task stop request "RTN","DVBA179P",95,0) . . S DVBMSG=2 "RTN","DVBA179P",96,0) . . S DVBMSG(1)="Patch DVBA*2.7*179 Field Population Task Stopped by User" "RTN","DVBA179P",97,0) . . S DVBMSG(2)="Re-run Post Install routine POST2^DVBA179P." "RTN","DVBA179P",98,0) . . S (ZTSTOP,DVBQUIT)=1 "RTN","DVBA179P",99,0) ; "RTN","DVBA179P",100,0) D NOTIFY(DVBSTART,DVBCNT,.DVBMSG) "RTN","DVBA179P",101,0) Q "RTN","DVBA179P",102,0) ; "RTN","DVBA179P",103,0) GETLAST(DVBIEN) ;get last activity date "RTN","DVBA179P",104,0) ; This function returns the most recent activity date on success. "RTN","DVBA179P",105,0) ; "RTN","DVBA179P",106,0) ; Fields Name "RTN","DVBA179P",107,0) ; 1 Request Date "RTN","DVBA179P",108,0) ; 4 Date Reported to MAS "RTN","DVBA179P",109,0) ; 6 Date Completed "RTN","DVBA179P",110,0) ; 13 Date Released "RTN","DVBA179P",111,0) ; 15 Date Printed by RO "RTN","DVBA179P",112,0) ; 19 Cancellation Date "RTN","DVBA179P",113,0) ; "RTN","DVBA179P",114,0) ; Input: "RTN","DVBA179P",115,0) ; DVBIEN - 2507 REQUEST file IEN "RTN","DVBA179P",116,0) ; "RTN","DVBA179P",117,0) ; Output: "RTN","DVBA179P",118,0) ; Funtion result - most recent activity date in FM format on success; "RTN","DVBA179P",119,0) ; otherwise, returns "0" "RTN","DVBA179P",120,0) ; "RTN","DVBA179P",121,0) N DVBDATS ;FM DIQ results array "RTN","DVBA179P",122,0) N DVBERR ;FM error msg "RTN","DVBA179P",123,0) N DVBFLD ;request field# "RTN","DVBA179P",124,0) N DVBIENS ;request record IENS "RTN","DVBA179P",125,0) N DVBLST ;last activity date - function result "RTN","DVBA179P",126,0) N DVBSRT ;activity dates sorted array "RTN","DVBA179P",127,0) ; "RTN","DVBA179P",128,0) S DVBLST=0 "RTN","DVBA179P",129,0) S DVBIENS=DVBIEN_"," "RTN","DVBA179P",130,0) D GETS^DIQ(396.3,DVBIENS,"1;4;6;13;15;19","I","DVBDATS","DVBERR") "RTN","DVBA179P",131,0) I '$D(DVBERR) D "RTN","DVBA179P",132,0) . S DVBFLD=0 "RTN","DVBA179P",133,0) . F S DVBFLD=$O(DVBDATS(396.3,DVBIENS,DVBFLD)) Q:'DVBFLD D "RTN","DVBA179P",134,0) . . S DVBSRT(+$G(DVBDATS(396.3,DVBIENS,DVBFLD,"I")))="" "RTN","DVBA179P",135,0) . S DVBLST=$P(+$O(DVBSRT(""),-1),".",1) "RTN","DVBA179P",136,0) Q DVBLST "RTN","DVBA179P",137,0) ; "RTN","DVBA179P",138,0) SETLAST(DVBIEN,DVBLAST) ;file the date in the new field "RTN","DVBA179P",139,0) ; File the last activity date in the DATE STATUS LAST CHANGED (#7) field "RTN","DVBA179P",140,0) ; "RTN","DVBA179P",141,0) ; Input: "RTN","DVBA179P",142,0) ; DVBIEN - 2507 REQUEST IEN "RTN","DVBA179P",143,0) ; DVBLAST - last activity date in FM format "RTN","DVBA179P",144,0) ; "RTN","DVBA179P",145,0) ; Output: "RTN","DVBA179P",146,0) ; Function result - returns 1 on success; otherwise returns 0 "RTN","DVBA179P",147,0) ; "RTN","DVBA179P",148,0) N DVBERR ;FM error msg "RTN","DVBA179P",149,0) N DVBFDA ;FDA array "RTN","DVBA179P",150,0) S DVBFDA(396.3,DVBIEN_",",7)=DVBLAST "RTN","DVBA179P",151,0) D FILE^DIE("","DVBFDA","DVBERR") "RTN","DVBA179P",152,0) Q $S($D(DVBERR):0,1:1) "RTN","DVBA179P",153,0) ; "RTN","DVBA179P",154,0) NOTIFY(DVBSTIME,DVBTOT,DVBMESS) ;send job msg "RTN","DVBA179P",155,0) ; "RTN","DVBA179P",156,0) ; Input "RTN","DVBA179P",157,0) ; DVBSTIME - job start date/time "RTN","DVBA179P",158,0) ; DVBTOT - count of records updated "RTN","DVBA179P",159,0) ; DVBMESS - free text message array for task stop or errors passed "RTN","DVBA179P",160,0) ; by reference "RTN","DVBA179P",161,0) ; "RTN","DVBA179P",162,0) ; Output "RTN","DVBA179P",163,0) ; none "RTN","DVBA179P",164,0) ; "RTN","DVBA179P",165,0) N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,XMZ "RTN","DVBA179P",166,0) N DVBSITE,DVBETIME,DVBTEXT,DVBI "RTN","DVBA179P",167,0) S DVBSITE=$$SITE^VASITE "RTN","DVBA179P",168,0) S DVBETIME=$$NOW^XLFDT "RTN","DVBA179P",169,0) S XMDUZ="Populate DATE STATUS LAST CHANGED" "RTN","DVBA179P",170,0) S XMSUB="Patch DVBA*2.7*179" "RTN","DVBA179P",171,0) S XMTEXT="DVBTEXT(" "RTN","DVBA179P",172,0) S XMY(DUZ)="" "RTN","DVBA179P",173,0) S DVBTEXT(1)="" "RTN","DVBA179P",174,0) S DVBTEXT(2)=" Facility Name: "_$P(DVBSITE,U,2) "RTN","DVBA179P",175,0) S DVBTEXT(3)=" Station Number: "_$P(DVBSITE,U,3) "RTN","DVBA179P",176,0) S DVBTEXT(4)="" "RTN","DVBA179P",177,0) S DVBTEXT(5)=" Date/Time job started: "_$$FMTE^XLFDT(DVBSTIME) "RTN","DVBA179P",178,0) S DVBTEXT(6)=" Date/Time job stopped: "_$$FMTE^XLFDT(DVBETIME) "RTN","DVBA179P",179,0) S DVBTEXT(7)="" "RTN","DVBA179P",180,0) I $G(DVBMESS) D "RTN","DVBA179P",181,0) . F DVBI=1:1:DVBMESS D "RTN","DVBA179P",182,0) . . S DVBTEXT(7+DVBI)="*** "_$E($G(DVBMESS(DVBI)),1,65) "RTN","DVBA179P",183,0) I '$G(DVBMESS) D "RTN","DVBA179P",184,0) . S DVBTEXT(8)="DATE STATUS LAST CHANGED (#7) Field Popluation Complete" "RTN","DVBA179P",185,0) . S DVBTEXT(9)="Total 2507 REQUEST (#396.3) Records Updated: "_DVBTOT "RTN","DVBA179P",186,0) D ^XMD "RTN","DVBA179P",187,0) Q "RTN","DVBAB1") 0^1^B100042303^B54842893 "RTN","DVBAB1",1,0) DVBAB1 ;ALB/SPH - CAPRI UTILITIES ; 12/12/11 3:52pm "RTN","DVBAB1",2,0) ;;2.7;AMIE;**35,37,50,42,53,57,73,104,109,137,146,143,179**;Apr 10, 1995;Build 15 "RTN","DVBAB1",3,0) ; "RTN","DVBAB1",4,0) VERSION(ZMSG,DVBGUIV) ; "RTN","DVBAB1",5,0) ; "RTN","DVBAB1",6,0) ; --rpc: DVBAB VERSION "RTN","DVBAB1",7,0) ; "RTN","DVBAB1",8,0) ; Must have a letter at the end of the Version for Delphi compatibility. "RTN","DVBAB1",9,0) ; 1st piece is version description "RTN","DVBAB1",10,0) ; 2nd piece can be YESOLD or NOOLD "RTN","DVBAB1",11,0) ; YESOLD --> Allow old GUI to run with new KID "RTN","DVBAB1",12,0) ; NOOLD --> Do not allow old GUI to run with newer version "RTN","DVBAB1",13,0) ; "RTN","DVBAB1",14,0) ; Ex: "CAPRI GUI V2.7*123*0*A^NOOLD" "RTN","DVBAB1",15,0) ; "RTN","DVBAB1",16,0) ; Sets variables DVBABVR* so that the error trap will display what "RTN","DVBAB1",17,0) ; version of the client software the user was utilizing if CAPRI bombs. "RTN","DVBAB1",18,0) ; "RTN","DVBAB1",19,0) N DVBVERS "RTN","DVBAB1",20,0) N DVBOLD "RTN","DVBAB1",21,0) ; "RTN","DVBAB1",22,0) ;obtain version parameters and build version string result "RTN","DVBAB1",23,0) S DVBVERS=$$GET^XPAR("PKG","DVBAB CAPRI MINIMUM VERSION",1,"Q") "RTN","DVBAB1",24,0) S DVBOLD=$$GET^XPAR("PKG","DVBAB CAPRI ALLOW OLD VERSION",1,"Q") "RTN","DVBAB1",25,0) S ZMSG=DVBVERS_"^"_$S(DVBOLD=1:"YESOLD",1:"NOOLD") "RTN","DVBAB1",26,0) ; "RTN","DVBAB1",27,0) ;set DVBABVR* vars for error trap "RTN","DVBAB1",28,0) S DVBABVR1="CAPRI Server Version: "_ZMSG "RTN","DVBAB1",29,0) S DVBABVR2="CAPRI GUI Version: "_$S($G(DVBGUIV)]"":DVBGUIV,1:"UNKNOWN") "RTN","DVBAB1",30,0) S DVBABVR3=$P(^VA(200,DUZ,0),"^",1) "RTN","DVBAB1",31,0) Q "RTN","DVBAB1",32,0) ; "RTN","DVBAB1",33,0) REQUESTS(Y,TYPE) ; "RTN","DVBAB1",34,0) ; TYPE is the internal value of field 17 in file 396.3 "RTN","DVBAB1",35,0) ; This relates to which status of request should be returned "RTN","DVBAB1",36,0) N DVBABCNT,DVBABIEN "RTN","DVBAB1",37,0) S DVBABCNT=0,DVBABIEN=0 "RTN","DVBAB1",38,0) F S DVBABIEN=$O(^DVB(396.3,DVBABIEN)) Q:'DVBABIEN D "RTN","DVBAB1",39,0) .S DVBABST=$P($G(^DVB(396.3,DVBABIEN,0)),"^",18) "RTN","DVBAB1",40,0) .I DVBABST=TYPE D "RTN","DVBAB1",41,0) ..S DVBABNM=$P($G(^DVB(396.3,DVBABIEN,0)),"^",1) "RTN","DVBAB1",42,0) ..S DVBABPT=DVBABNM "RTN","DVBAB1",43,0) ..I DVBABNM'="" S DVBABNM=$P($G(^DPT(DVBABNM,0)),"^",1) "RTN","DVBAB1",44,0) ..S DVBABDT=$$FMTE^XLFDT($P($G(^DVB(396.3,DVBABIEN,0)),"^",2),"2D") "RTN","DVBAB1",45,0) ..S DVBABWHO=$P($G(^DVB(396.3,DVBABIEN,0)),"^",4) "RTN","DVBAB1",46,0) ..I DVBABWHO'="" S DVBABWHO=$P($G(^VA(200,DVBABWHO,0)),"^",1) "RTN","DVBAB1",47,0) ..E S DVBABWHO="UNKNOWN" "RTN","DVBAB1",48,0) ..S DVBABRO=$P($G(^DVB(396.3,DVBABIEN,0)),"^",3) "RTN","DVBAB1",49,0) ..I DVBABRO'="" S DVBABRO=$P($G(^DIC(4,DVBABRO,0)),"^",1) "RTN","DVBAB1",50,0) ..E S DVBABRO="UNKNOWN" "RTN","DVBAB1",51,0) ..S ^TMP("DVBAREQ",DUZ,DVBABCNT)=DVBABST_"^"_DVBABPT_"^"_DVBABNM_"^"_DVBABDT_"^"_DVBABWHO_"^"_DVBABRO_"^"_DVBABIEN_$C(13),DVBABCNT=DVBABCNT+1 "RTN","DVBAB1",52,0) S Y=$NA(^TMP("DVBAREQ",DUZ)) "RTN","DVBAB1",53,0) K DVBABCNT,DVBABIEN,TYPE,DVBABNM,DVBABDT,DVBABST,DVBABWHO,DVBABPT "RTN","DVBAB1",54,0) Q "RTN","DVBAB1",55,0) TEAMPTS(DVBORY,TEAM,TMPFLAG) ; RETURN LIST OF PATIENTS IN A TEAM "RTN","DVBAB1",56,0) ; If TMPFLAG passed and = TRUE, code expects a "^TMP(xxx" "RTN","DVBAB1",57,0) ; global root string passed in ORY, and builds the returned "RTN","DVBAB1",58,0) ; list in that global instead of to a memory array. "RTN","DVBAB1",59,0) N DOTMP,NEWTMP,DVBSSN,DVBORI,DVBORPT,I "RTN","DVBAB1",60,0) K ^TMP("DVBATMPT",DUZ) "RTN","DVBAB1",61,0) S (I,DOTMP,DVBORI)=0 "RTN","DVBAB1",62,0) I $G(TMPFLAG) D ; Was value passed? "RTN","DVBAB1",63,0) .I TMPFLAG S DOTMP=1 ; Is value TRUE? "RTN","DVBAB1",64,0) I +$G(TEAM)<1 D "RTN","DVBAB1",65,0) .I DOTMP S NEWTMP=DVBORY_1_")",@NEWTMP="^No team identified" "RTN","DVBAB1",66,0) .E S DVBORY(1)="^No team identified" "RTN","DVBAB1",67,0) F S DVBORI=$O(^OR(100.21,+TEAM,10,DVBORI)) Q:DVBORI<1 D "RTN","DVBAB1",68,0) .S DVBORPT=^OR(100.21,+TEAM,10,DVBORI,0) "RTN","DVBAB1",69,0) .I DOTMP D "RTN","DVBAB1",70,0) ..S I=I+1,NEWTMP=DVBORY_+I_")" "RTN","DVBAB1",71,0) ..S @NEWTMP=+DVBORPT_U_$P(^DPT(+DVBORPT,0),U) "RTN","DVBAB1",72,0) .S DVBSSN=$P($G(^DPT($P(DVBORPT,";",1),0)),U,9) "RTN","DVBAB1",73,0) .E S I=I+1,^TMP("DVBATMPT",DUZ,I)=+DVBORPT_U_$P(^DPT(+DVBORPT,0),U)_U_DVBSSN_$C(13) "RTN","DVBAB1",74,0) I DOTMP S:I<1 NEWTMP=DVBORY_1_")",@NEWTMP="^No patients found." "RTN","DVBAB1",75,0) E S:I<1 ^TMP("DVBATMPT",DUZ,1)="^No patients found." "RTN","DVBAB1",76,0) S DVBORY=$NA(^TMP("DVBATMPT",DUZ)) "RTN","DVBAB1",77,0) Q "RTN","DVBAB1",78,0) DIVISION(Y) ; Returns Name for an Institution "RTN","DVBAB1",79,0) N DVBARR,DVBERR,DVBATP "RTN","DVBAB1",80,0) S Y="" "RTN","DVBAB1",81,0) Q:$G(DUZ(2))="" "RTN","DVBAB1",82,0) D GETS^DIQ(4,DUZ(2)_",0",".01","I","DVBARR","DVBERR") "RTN","DVBAB1",83,0) Q:$D(DVBERR) "RTN","DVBAB1",84,0) S Y=$G(DVBARR(4,DUZ(2)_",0,",.01,"I")) "RTN","DVBAB1",85,0) D GETS^DIQ(4,DUZ(2)_",0",13,"I","DVBARR","DVBERR") "RTN","DVBAB1",86,0) S DVBATP=$G(DVBARR(4,DUZ(2)_",0,",13,"I")) "RTN","DVBAB1",87,0) I DVBATP'="" S DVBATP=$P($G(^DIC(4.1,DVBATP,0)),"^",1) "RTN","DVBAB1",88,0) S Y=Y_"-"_DVBATP "RTN","DVBAB1",89,0) Q "RTN","DVBAB1",90,0) ; "RTN","DVBAB1",91,0) DT(Y,X1,X2) ; Returns date X1 minus X2 days "RTN","DVBAB1",92,0) ; change the '00:00' that could be passed so Fileman doesn't reject "RTN","DVBAB1",93,0) ;C^%DTC(X1,X2) "RTN","DVBAB1",94,0) ;S %DT=$G(%DT,"TS") D ^%DT "RTN","DVBAB1",95,0) ;K %DT,X1,X2 "RTN","DVBAB1",96,0) ;Q "RTN","DVBAB1",97,0) DTTM(Y) ; "RTN","DVBAB1",98,0) S Y=$$HTE^XLFDT($H,"P") "RTN","DVBAB1",99,0) Q "RTN","DVBAB1",100,0) CHKCRED(Y) ;KLB "RTN","DVBAB1",101,0) S Y="[OK]" "RTN","DVBAB1",102,0) I '$D(DUZ(2)) S Y="Your division number is missing." Q "RTN","DVBAB1",103,0) I $D(DUZ)#2=0 S Y="Your user number is invalid." Q "RTN","DVBAB1",104,0) I +DUZ(2)<1 S Y="Invalid division." "RTN","DVBAB1",105,0) Q "RTN","DVBAB1",106,0) PTINQ(REF,DFN) ; Return formatted pt inquiry report "RTN","DVBAB1",107,0) K ^TMP("ORDATA",$J,1) "RTN","DVBAB1",108,0) ; DVBA*2.7*109 - Added $D to next line "RTN","DVBAB1",109,0) I ($D(^DPT(DFN,0))) D START^ORWRP(80,"DGINQB^ORCXPND1(DFN)") "RTN","DVBAB1",110,0) S REF=$NA(^TMP("ORDATA",$J,1)) "RTN","DVBAB1",111,0) Q "RTN","DVBAB1",112,0) TEMPLATE(Y) ; Returns list of CAPRI exam templates "RTN","DVBAB1",113,0) N DVBABCNT,DVBABIEN,DVBABNM,DVBABAD,DVBABDD,DVBABSL,DVBABOC "RTN","DVBAB1",114,0) K Y,^TMP("DVBALAB1",DUZ) "RTN","DVBAB1",115,0) S DVBABCNT=0,DVBABIEN=0 "RTN","DVBAB1",116,0) F S DVBABIEN=$O(^DVB(396.18,DVBABIEN)) Q:'DVBABIEN D "RTN","DVBAB1",117,0) .S DVBABNM=$P($G(^DVB(396.18,DVBABIEN,0)),"^",1) "RTN","DVBAB1",118,0) .S DVBABAD=$P($G(^DVB(396.18,DVBABIEN,2)),"^",1) "RTN","DVBAB1",119,0) .S DVBABDD=$P($G(^DVB(396.18,DVBABIEN,2)),"^",2) "RTN","DVBAB1",120,0) .S DVBABSL=$P($G(^DVB(396.18,DVBABIEN,6)),"^",1) "RTN","DVBAB1",121,0) .S DVBABOC=$P($G(^DVB(396.18,DVBABIEN,6)),"^",2) "RTN","DVBAB1",122,0) .S ^TMP("DVBATMPL",DUZ,DVBABCNT)=DVBABNM_"^"_DVBABAD_"^"_DVBABDD_"^"_DVBABSL_"^"_DVBABOC_"^"_DVBABIEN_$C(13),DVBABCNT=DVBABCNT+1 "RTN","DVBAB1",123,0) S Y=$NA(^TMP("DVBATMPL",DUZ)) "RTN","DVBAB1",124,0) Q "RTN","DVBAB1",125,0) ; "RTN","DVBAB1",126,0) LABLIST(Y) ; Returns list of LAB TEST NAMES "RTN","DVBAB1",127,0) N DVBABCNT,DVBABIEN,DVBABLNM "RTN","DVBAB1",128,0) K Y,^TMP("DVBALAB1",DUZ) "RTN","DVBAB1",129,0) S DVBABCNT=0,DVBABIEN=0 "RTN","DVBAB1",130,0) F S DVBABIEN=$O(^LAB(60,DVBABIEN)) Q:'DVBABIEN D "RTN","DVBAB1",131,0) .S DVBABLNM=$P($G(^LAB(60,DVBABIEN,0)),"^",1) "RTN","DVBAB1",132,0) .S ^TMP("DVBALAB1",DUZ,DVBABCNT)=DVBABLNM_"^"_DVBABIEN_$C(13),DVBABCNT=DVBABCNT+1 "RTN","DVBAB1",133,0) S Y=$NA(^TMP("DVBALAB1",DUZ)) "RTN","DVBAB1",134,0) Q "RTN","DVBAB1",135,0) ; "RTN","DVBAB1",136,0) INSTLIST(Y) ; Returns full list of Institutions "RTN","DVBAB1",137,0) N DVBABCNT,DVBABIEN,DVBABNM,DVBABSTN,DVBABST,DVBABDS,DVBARR,DVBERR,DVBATP "RTN","DVBAB1",138,0) K Y,^TMP("DVBAINST",$J,DUZ) "RTN","DVBAB1",139,0) S (DVBABCNT,DVBABIEN)=0 "RTN","DVBAB1",140,0) F S DVBABIEN=$O(^DIC(4,DVBABIEN)) Q:'DVBABIEN D "RTN","DVBAB1",141,0) . K DVBARR,DVBERR "RTN","DVBAB1",142,0) . D GETS^DIQ(4,DVBABIEN_",0",".01:.02:.03:","I","DVBARR","DVBERR") "RTN","DVBAB1",143,0) . Q:$D(DVBERR) "RTN","DVBAB1",144,0) . S DVBABNM=$G(DVBARR(4,DVBABIEN_",0,",.01,"I")) "RTN","DVBAB1",145,0) . Q:DVBABNM="" "RTN","DVBAB1",146,0) . S DVBABSTN=$G(DVBARR(4,DVBABIEN_",0,",.02,"I")) "RTN","DVBAB1",147,0) . Q:DVBABSTN="" "RTN","DVBAB1",148,0) . S DVBABDS=$G(DVBARR(4,DVBABIEN_",0,",.03,"I")) "RTN","DVBAB1",149,0) . K DVBARR,DVBERR "RTN","DVBAB1",150,0) . D GETS^DIQ(5,DVBABSTN_",0",.01,"I","DVBARR","DVBERR") "RTN","DVBAB1",151,0) . Q:$D(DVBERR) "RTN","DVBAB1",152,0) . S DVBABST=$G(DVBARR(5,DVBABSTN_",0,",.01,"I")) "RTN","DVBAB1",153,0) . K DVBARR,DVBERR "RTN","DVBAB1",154,0) . D GETS^DIQ(4,DVBABIEN_",0",13,"I","DVBARR","DVBERR") "RTN","DVBAB1",155,0) . S DVBATP=$G(DVBARR(4,DVBABIEN_",0,",13,"I")) "RTN","DVBAB1",156,0) . I DVBATP'="" D "RTN","DVBAB1",157,0) .. S DVBATP=$P($G(^DIC(4.1,DVBATP,0)),"^",1) "RTN","DVBAB1",158,0) . S ^TMP("DVBAINST",$J,DUZ,DVBABCNT)=DVBABNM_"-"_DVBATP_"^"_DVBABST_"^"_DVBABDS_"^"_DVBABIEN_$C(13) "RTN","DVBAB1",159,0) . S DVBABCNT=DVBABCNT+1 "RTN","DVBAB1",160,0) S Y=$NA(^TMP("DVBAINST",$J,DUZ)) "RTN","DVBAB1",161,0) Q "RTN","DVBAB1",162,0) ; "RTN","DVBAB1",163,0) INCEXAM(ZMSG) ;Increased exam # in file and passes back the # to user "RTN","DVBAB1",164,0) S ZMSG=+$G(^DVB(396.1,1,5))+1 "RTN","DVBAB1",165,0) S ^DVB(396.1,1,5)=ZMSG "RTN","DVBAB1",166,0) Q "RTN","DVBAB1",167,0) ; "RTN","DVBAB1",168,0) MSG(ERR,DUZ,XMSUB,XMTEXT,MGN,ID) ;Generate mail message;KLB "RTN","DVBAB1",169,0) ; --rpc: DVBAB SEND MSG "RTN","DVBAB1",170,0) ; "RTN","DVBAB1",171,0) ; This remote procedure is used to generate bulletins for specific CAPRI actions, such as cancellation of 2507 exams. "RTN","DVBAB1",172,0) ; "RTN","DVBAB1",173,0) ; Supported References: "RTN","DVBAB1",174,0) ; DBIA #10111: Allows FM read access of ^XMB(3.8,D0,0) using DIC. "RTN","DVBAB1",175,0) K ^TMP($J,"AMIE") "RTN","DVBAB1",176,0) S XMB="",XMDUZ=DUZ "RTN","DVBAB1",177,0) I '$D(DUZ) S ERR="MISSING DUZ" Q "RTN","DVBAB1",178,0) I '$D(XMSUB) S ERR="MISSING SUBJECT" Q "RTN","DVBAB1",179,0) I '$D(XMTEXT) S ERR="MISSING TEXT" Q "RTN","DVBAB1",180,0) I '$D(MGN) S ERR="MISSING MAIL GROUP NAME" Q "RTN","DVBAB1",181,0) ;IF MGN=DVBA C 2507 EXAM READY NO BULLETIN NECESSARY, BUILD THE EMAIL AND QUIT "RTN","DVBAB1",182,0) I MGN="DVBA C 2507 EXAM READY" D SENDMSG Q "RTN","DVBAB1",183,0) S J=0 "RTN","DVBAB1",184,0) F S J=$O(XMTEXT(J)) Q:'J S ^TMP($J,"AMIE",J)=$G(XMTEXT(J)) "RTN","DVBAB1",185,0) S XMTEXT="^TMP($J,""AMIE""," "RTN","DVBAB1",186,0) S DIC="^XMB(3.8,",DIC(0)="QM",X=MGN D ^DIC "RTN","DVBAB1",187,0) I +Y<0 S ERR="INVALID MAIL GROUP NAME" Q "RTN","DVBAB1",188,0) I '$$GOTLOCAL^XMXAPIG(MGN) S ERR="NO ACTIVE LOCAL MEMBERS IN MAIL GROUP" K ^TMP("XMERR",$J) Q "RTN","DVBAB1",189,0) I MGN="DVBA C NEW C&P VETERAN" S XMB="DVBA CAPRI NEW C&P VETERAN" "RTN","DVBAB1",190,0) I MGN="DVBA C 2507 CANCELLATION" S XMB="DVBA CAPRI 2507 CANCELLATION" "RTN","DVBAB1",191,0) I XMB="" S ERR="UNABLE TO SET BULLETIN" Q "RTN","DVBAB1",192,0) D ^XMB "RTN","DVBAB1",193,0) ;XMB = -1 if bulletin not found in file (#3.6) "RTN","DVBAB1",194,0) S ERR=$S(XMB=-1:"BULLETIN NOT FOUND",1:"MESSAGE SENT") "RTN","DVBAB1",195,0) ;before we quit, send a message to the requestor if the message is a cancellation "RTN","DVBAB1",196,0) I MGN="DVBA C 2507 CANCELLATION" D SENDMSG "RTN","DVBAB1",197,0) K XMSUB,XMTEXT,MGN,DIC,DIC(0),J,Y,XMDUZ,XMB "RTN","DVBAB1",198,0) Q "RTN","DVBAB1",199,0) FINDEXAM(ZMSG,ZIEN) ;Returns list of exams in 396.4 that are linked to ZIEN in 396.3 "RTN","DVBAB1",200,0) N DVBABCNT,DVBABIEN "RTN","DVBAB1",201,0) S DVBABCNT=0,DVBABIEN=0 "RTN","DVBAB1",202,0) F S DVBABIEN=$O(^DVB(396.4,"C",ZIEN,DVBABIEN)) Q:'DVBABIEN D "RTN","DVBAB1",203,0) .S DVBABD1=$P($G(^DVB(396.4,DVBABIEN,0)),"^",2) "RTN","DVBAB1",204,0) .S DVBABD2=$P($G(^DVB(396.6,+$P($G(^DVB(396.4,DVBABIEN,0)),"^",3),0)),"^",1) ;Name of Exam "RTN","DVBAB1",205,0) .S DVBABD3=$P($G(^DVB(396.4,DVBABIEN,0)),"^",4) "RTN","DVBAB1",206,0) .I DVBABD3="O" S DVBABD3="[OPEN]" "RTN","DVBAB1",207,0) .I DVBABD3="C" S DVBABD3="[COMPLETE]" "RTN","DVBAB1",208,0) .I DVBABD3="X" S DVBABD3="[CANCELED BY MAS]" "RTN","DVBAB1",209,0) .I DVBABD3="RX" S DVBABD3="[CANCELED BY RO]" "RTN","DVBAB1",210,0) .I DVBABD3="T" S DVBABD3="[TRANSFERRED OUT]" "RTN","DVBAB1",211,0) .I ZIEN=DVBABD1 D "RTN","DVBAB1",212,0) ..S ZMSG(DVBABCNT)=DVBABIEN_"^"_DVBABD2_" "_DVBABD3 "RTN","DVBAB1",213,0) ..S DVBABCNT=DVBABCNT+1 "RTN","DVBAB1",214,0) K DVBABCNT,DVBABIEN,ZIEN,DVBABD1,DVBABD2,DVBABD3 "RTN","DVBAB1",215,0) Q "RTN","DVBAB1",216,0) SENDMSG ;SET UP TO SEND EMAIL/NOTIFICATION TO REQUESTOR OF 2507 "RTN","DVBAB1",217,0) N DVBA0,DVBAREQ,DVBAEA,DVBAC,DVBAQUIT,DVBADFN,DVBASITE,DVBADT,DUZ "RTN","DVBAB1",218,0) ;SINCE MAILMAN DOES NOT ALLOW MESSAGES TO BE SENT FROM USERS WITHOUT ACCESS CODES OR MAILBOXES "RTN","DVBAB1",219,0) ;WHICH CAPRI REMOTE USER DO NOT HAVE, WE HAVE TO NEW DUZ AND CHANGE XMDUZ TO THE NAME OF THE USER "RTN","DVBAB1",220,0) ;AS A STRING SO THE PROCESS IS STILL LINKED TO THE USER SENDING/TRIGGERING THE MESSAGE "RTN","DVBAB1",221,0) I $G(ID)="" Q "RTN","DVBAB1",222,0) S XMDUZ=$P(^VA(200,XMDUZ,0),"^",1)_" CAPRI" "RTN","DVBAB1",223,0) S DVBA0=$G(^DVB(396.3,ID,0)) "RTN","DVBAB1",224,0) S DVBADFN=$P(DVBA0,"^",1),DVBAREQ=$P(DVBA0,"^",4),DVBADT=$$FMTE^XLFDT($P(DVBA0,"^",2)) "RTN","DVBAB1",225,0) ;following call supported by IA 3858 "RTN","DVBAB1",226,0) S DVBAEA=$P($G(^VA(200,DVBAREQ,.15)),"^",1) "RTN","DVBAB1",227,0) I DVBAEA'="" D "RTN","DVBAB1",228,0) . S XMY(DVBAEA)="",DVBASITE=$$SITE^VASITE "RTN","DVBAB1",229,0) . I MGN="DVBA C 2507 CANCELLATION" D CNCLMSG Q "RTN","DVBAB1",230,0) . I MGN="DVBA C 2507 EXAM READY" D RDYMSG Q "RTN","DVBAB1",231,0) Q "RTN","DVBAB1",232,0) CNCLMSG ;SEND CANCEL MESSAGE TO REQUESTOR OF THE 2507 EXAM "RTN","DVBAB1",233,0) ;need to loop through previously built text to make sure all PII is removed "RTN","DVBAB1",234,0) S J=0,DVBAQUIT=0 "RTN","DVBAB1",235,0) F S J=$O(^TMP($J,"AMIE",J)) Q:'J!(DVBAQUIT) D "RTN","DVBAB1",236,0) .I $G(^TMP($J,"AMIE",J))["Name" S ^TMP($J,"AMIE",J)="DFN: `"_DVBADFN_" SITE: "_$P($G(DVBASITE),"^",2)_" Request Date: "_DVBADT "RTN","DVBAB1",237,0) .I $G(^TMP($J,"AMIE",J))["Additional Comments" D Q "RTN","DVBAB1",238,0) ..S ^TMP($J,"AMIE1",J)="**NOTE: To view the patient using the DFN, paste the DFN number into the CAPRI" "RTN","DVBAB1",239,0) ..S ^TMP($J,"AMIE1",J+1)="Patient Selector 'Patient ID' field to find the patient. Be sure to include" "RTN","DVBAB1",240,0) ..S ^TMP($J,"AMIE1",J+2)="the ` (backward-apostrophe) character." "RTN","DVBAB1",241,0) ..S ^TMP($J,"AMIE1",J+3)="" "RTN","DVBAB1",242,0) ..S ^TMP($J,"AMIE1",J+4)="" "RTN","DVBAB1",243,0) ..S ^TMP($J,"AMIE1",J+4)="" "RTN","DVBAB1",244,0) ..S ^TMP($J,"AMIE1",J+5)="*****This is an auto-generated email. Do not respond to this email address.*****" "RTN","DVBAB1",245,0) ..S DVBAQUIT=1 Q "RTN","DVBAB1",246,0) .S ^TMP($J,"AMIE1",J)=$G(^TMP($J,"AMIE",J)) "RTN","DVBAB1",247,0) S XMTEXT="^TMP($J,""AMIE1""," "RTN","DVBAB1",248,0) D ^XMD "RTN","DVBAB1",249,0) K ^TMP($J,"AMIE1") "RTN","DVBAB1",250,0) Q "RTN","DVBAB1",251,0) RDYMSG ;SEND EXAM COMPLETE MESSAGE TO REQUESTOR OF 2507 "RTN","DVBAB1",252,0) ;no text/body is passed in so we have to build the message from scratch "RTN","DVBAB1",253,0) S ^TMP($J,"AMIE1",1)="A 2507 request as described below has been completed and released to the regional office , and is now available in CAPRI." "RTN","DVBAB1",254,0) S ^TMP($J,"AMIE1",2)="" "RTN","DVBAB1",255,0) S ^TMP($J,"AMIE1",3)="" "RTN","DVBAB1",256,0) S ^TMP($J,"AMIE1",4)=" DFN: `"_DVBADFN "RTN","DVBAB1",257,0) S ^TMP($J,"AMIE1",5)=" Vista Site: "_$P($G(DVBASITE),"^",2) "RTN","DVBAB1",258,0) S ^TMP($J,"AMIE1",6)=" Request Date: "_DVBADT "RTN","DVBAB1",259,0) S ^TMP($J,"AMIE1",7)="" "RTN","DVBAB1",260,0) S ^TMP($J,"AMIE1",8)="" "RTN","DVBAB1",261,0) S ^TMP($J,"AMIE1",9)="**NOTE: To view the patient using the DFN, paste the DFN number into the CAPRI" "RTN","DVBAB1",262,0) S ^TMP($J,"AMIE1",10)="Patient Selector 'Patient ID' field to find the patient. Be sure to include" "RTN","DVBAB1",263,0) S ^TMP($J,"AMIE1",11)="the ` (backward-apostrophe) character." "RTN","DVBAB1",264,0) S ^TMP($J,"AMIE1",12)="" "RTN","DVBAB1",265,0) S ^TMP($J,"AMIE1",13)="" "RTN","DVBAB1",266,0) S ^TMP($J,"AMIE1",14)="" "RTN","DVBAB1",267,0) S ^TMP($J,"AMIE1",15)="*****This is an auto-generated email. Do not respond to this email address.*****" "RTN","DVBAB1",268,0) S XMTEXT="^TMP($J,""AMIE1""," "RTN","DVBAB1",269,0) D ^XMD "RTN","DVBAB1",270,0) K ^TMP($J,"AMIE1") "RTN","DVBAB1",271,0) K XMSUB,XMTEXT,MGN,XMDUZ "RTN","DVBAB1",272,0) Q "RTN","DVBAB51") 0^4^B51087227^B44742648 "RTN","DVBAB51",1,0) DVBAB51 ;ALB/VM - CAPRI INCOMPETENT PATIENT REPORT ; 3/21/12 3:21pm "RTN","DVBAB51",2,0) ;;2.7;AMIE;**35,149,179**;Apr 10, 1995;Build 15 "RTN","DVBAB51",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","DVBAB51",4,0) ; "RTN","DVBAB51",5,0) ;Input: ZMSG - Output Array for incompetent report (By Ref) "RTN","DVBAB51",6,0) ; BDATE - Beginning date for report (FM Format) "RTN","DVBAB51",7,0) ; EDATE - Ending date for report (FM Format) "RTN","DVBAB51",8,0) ; DVBADLMTR - Indicates if report should be delimitted (Optional) "RTN","DVBAB51",9,0) ; CAPRI currently executes RPC by each day in "RTN","DVBAB51",10,0) ; date range, so DVBADLMTR should equal the "RTN","DVBAB51",11,0) ; final EDATE in range so that XTMP global "RTN","DVBAB51",12,0) ; can be killed. "RTN","DVBAB51",13,0) ;Output: ^TMP("DVBAR",$J) contains delimited/non-delimited incompetent report "RTN","DVBAB51",14,0) STRT(ZMSG,BDATE,EDATE,DVBADLMTR) ;ENTER HERE "RTN","DVBAB51",15,0) N DVBAFNLDTE,MA1 "RTN","DVBAB51",16,0) S DVBABCNT=0,RO="N",RONUM=0 "RTN","DVBAB51",17,0) S DVBAFNLDTE=$S(+$G(DVBADLMTR):+$P(DVBADLMTR,"."),1:0) "RTN","DVBAB51",18,0) S DVBADLMTR=$S('+$G(DVBADLMTR):"",1:"^") "RTN","DVBAB51",19,0) K ^TMP($J) G TERM "RTN","DVBAB51",20,0) SET Q:'$D(^DPT(DA,.29)) S ICDAT=^(.29) Q:$P(ICDAT,U,12)'=1&(ICDAT']"") S INCMP="" S:$P(ICDAT,U)]""!($P(ICDAT,U,12)=1) INCMP=1 Q:INCMP'=1 S ICDAT2=$P(ICDAT,U,2),ICDAT=$P(ICDAT,U) "RTN","DVBAB51",21,0) S:ICDAT]"" ICDAT=$$FMTE^XLFDT(ICDAT,"5DZ") "RTN","DVBAB51",22,0) S:ICDAT2]"" ICDAT2=$$FMTE^XLFDT(ICDAT2,"5DZ") "RTN","DVBAB51",23,0) Q:'$D(^DPT(DA,0)) S DFN=DA D RCV^DVBAVDPT Q:CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376) "RTN","DVBAB51",24,0) S MA1=$P(MA,".",1) "RTN","DVBAB51",25,0) S ^TMP($J,MA1,XCN,CFLOC,MB,DA)=RCVAA_U_RCVPEN_U_CNUM_U_ICDAT_U_ICDAT2_U_INCMP "RTN","DVBAB51",26,0) Q "RTN","DVBAB51",27,0) ; "RTN","DVBAB51",28,0) PRINTB S RCVAA=$P(DATA,U),RCVPEN=$P(DATA,U,2),CNUM=$P(DATA,U,3),ICDAT=$P(DATA,U,4),ICDAT2=$P(DATA,U,5),INCMP=$P(DATA,U,6),DFN=DA,QUIT1=1 D ADM^DVBAVDPT "RTN","DVBAB51",29,0) S ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ") "RTN","DVBAB51",30,0) S DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ") "RTN","DVBAB51",31,0) S LADM=ADM,TDIS="UNKNOWN",TO="",DCHPTR=$P(^DGPM(LADM,0),U,17),TDIS=$S($D(^DGPM(+DCHPTR,0)):$P(^(0),U,18),1:"") I TDIS="" S TDIS="Unknown discharge type" "RTN","DVBAB51",32,0) S:'$D(^DG(405.2,+TDIS,0)) TDIS="Unknown discharge type" I $D(^(0)) S TDIS=$S($P(^DG(405.2,+TDIS,0),U,1)]"":$P(^(0),U,1),1:"Unknown discharge type") "RTN","DVBAB51",33,0) S:(IOST?1"C-".E)!($D(DVBAON2)) ^TMP("DVBAR",$J,DVBABCNT)=" ",DVBABCNT=DVBABCNT+1 "RTN","DVBAB51",34,0) ;***vm-out*W !!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!! "RTN","DVBAB51",35,0) ;create delimited/non-delimited report "RTN","DVBAB51",36,0) D:($G(DVBADLMTR)'="") PRINTD "RTN","DVBAB51",37,0) D:($G(DVBADLMTR)="") PRINTND "RTN","DVBAB51",38,0) S DVBAON2="" "RTN","DVBAB51",39,0) Q "RTN","DVBAB51",40,0) ; "RTN","DVBAB51",41,0) PRINTND ;create non-delimited incompetent report "RTN","DVBAB51",42,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Patient Name: "_PNAM,DVBABCNT=DVBABCNT+1,^TMP("DVBAR",$J,DVBABCNT)=" ",DVBABCNT=DVBABCNT+1 "RTN","DVBAB51",43,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Claim No: "_CNUM,DVBABCNT=DVBABCNT+1 "RTN","DVBAB51",44,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Claim Folder Loc: "_CFLOC,DVBABCNT=DVBABCNT+1 "RTN","DVBAB51",45,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Social Sec No: "_SSN,DVBABCNT=DVBABCNT+1 "RTN","DVBAB51",46,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Admission Date: "_ADMDT,DVBABCNT=DVBABCNT+1 "RTN","DVBAB51",47,0) S ^TMP("DVBAR",$J,DVBABCNT)="Admitting Diagnosis: "_DIAG,DVBABCNT=DVBABCNT+1 "RTN","DVBAB51",48,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Discharge Date: "_DCHGDT,DVBABCNT=DVBABCNT+1 "RTN","DVBAB51",49,0) I DCHGDT]"" S ^TMP("DVBAR",$J,DVBABCNT)=" Type of Discharge: "_TDIS_$S(TO]"":" TO "_$S($D(^DIC(4,+TO,0)):$P(^(0),U,1),1:""),1:""),DVBABCNT=DVBABCNT+1 "RTN","DVBAB51",50,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Bed Service: "_BEDSEC,DVBABCNT=DVBABCNT+1 "RTN","DVBAB51",51,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Recv A&A?: "_$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified"),DVBABCNT=DVBABCNT+1 "RTN","DVBAB51",52,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Pension?: "_$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified"),DVBABCNT=DVBABCNT+1 "RTN","DVBAB51",53,0) ;***vm-out*D ELIG^DVBAVDPT "RTN","DVBAB51",54,0) ELIG S ELIG=DVBAELIG,INCMP="" "RTN","DVBAB51",55,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Eligibility data: " "RTN","DVBAB51",56,0) I ELIG]"" S ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")" "RTN","DVBAB51",57,0) I $D(^DPT(DA,.29)) S INCMP=$S($P(^(.29),U,12)=1:"Incompetent",1:"") "RTN","DVBAB51",58,0) S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_ELIG_$S(((ELIG]"")&(INCMP]"")):", ",1:"")_INCMP,DVBABCNT=DVBABCNT+1 "RTN","DVBAB51",59,0) S ^TMP("DVBAR",$J,DVBABCNT)=" DATE RULED INCOMP: "_$S($D(ICDAT)]"":ICDAT_" (VA)",1:"")_$S(ICDAT2]"":" - "_ICDAT2_" (CIVIL)",1:" "),DVBABCNT=DVBABCNT+1 "RTN","DVBAB51",60,0) ;***vm-out*I IOST?1"C-".E W *7,!,"Press RETURN to continue or ""^"" to stop " R ANS:DTIME S:ANS=U!('$T) QUIT=1 I '$T S DVBAQUIT=1 "RTN","DVBAB51",61,0) Q "RTN","DVBAB51",62,0) ; "RTN","DVBAB51",63,0) PRINTD ;create delimited incompetent report "RTN","DVBAB51",64,0) D:('$D(^XTMP("DVBA_INCOMPETENT_RPT"_$J,0))) COLHDR "RTN","DVBAB51",65,0) S ^TMP("DVBAR",$J,DVBABCNT)=PNAM_DVBADLMTR_CNUM_DVBADLMTR_CFLOC_DVBADLMTR_SSN_DVBADLMTR_ADMDT_DVBADLMTR_DIAG_DVBADLMTR_DCHGDT_DVBADLMTR "RTN","DVBAB51",66,0) S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_$S((DCHGDT]""):TDIS_$S(TO]"":" TO "_$S($D(^DIC(4,+TO,0)):$P(^(0),U,1),1:""),1:""),1:"")_DVBADLMTR "RTN","DVBAB51",67,0) S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_BEDSEC_DVBADLMTR_""_$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified")_DVBADLMTR "RTN","DVBAB51",68,0) S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified")_DVBADLMTR "RTN","DVBAB51",69,0) ; "RTN","DVBAB51",70,0) S ELIG=DVBAELIG,INCMP="" "RTN","DVBAB51",71,0) I ELIG]"" S ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")" "RTN","DVBAB51",72,0) I $D(^DPT(DA,.29)) S INCMP=$S($P(^(.29),U,12)=1:"Incompetent",1:"") "RTN","DVBAB51",73,0) ; "RTN","DVBAB51",74,0) S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_ELIG_$S(ELIG]"":", ",1:"")_INCMP_DVBADLMTR_$S($D(ICDAT)]"":ICDAT_" (VA)",1:"")_$S(ICDAT2]"":" - "_ICDAT2_" (CIVIL)",1:"") "RTN","DVBAB51",75,0) S DVBABCNT=DVBABCNT+1 "RTN","DVBAB51",76,0) Q "RTN","DVBAB51",77,0) ; "RTN","DVBAB51",78,0) PRINT U IO S QUIT="" "RTN","DVBAB51",79,0) S MA="" F H=0:0 S MA=$O(^TMP($J,MA)) Q:MA=""!(QUIT=1) S XCN="" F M=0:0 S XCN=$O(^TMP($J,MA,XCN)) Q:XCN=""!(QUIT=1) S CFLOC="" F J=0:0 S CFLOC=$O(^TMP($J,MA,XCN,CFLOC)) Q:CFLOC=""!(QUIT=1) D PRINT1 "RTN","DVBAB51",80,0) Q "RTN","DVBAB51",81,0) PRINT1 S ADM="" F K=0:0 S ADM=$O(^TMP($J,MA,XCN,CFLOC,ADM)) Q:ADM=""!(QUIT=1) S DA="" F L=0:0 S DA=$O(^TMP($J,MA,XCN,CFLOC,ADM,DA)) Q:DA=""!(QUIT=1) S DATA=^(DA) D PRINTB "RTN","DVBAB51",82,0) Q "RTN","DVBAB51",83,0) ; "RTN","DVBAB51",84,0) TERM ;D HOME^%ZIS K NOASK "RTN","DVBAB51",85,0) K NOASK "RTN","DVBAB51",86,0) ; "RTN","DVBAB51",87,0) SETUP ;W @IOF,!,"VARO INCOMPETENCY REPORT" D NOPARM^DVBAUTL2 "RTN","DVBAB51",88,0) NOPARM ;check for AMIE parameter setup "RTN","DVBAB51",89,0) I '$D(^DVB(396.1,1,0)) S ^TMP("DVBAR",$J,DVBABCNT)="No site parameters have been set up in file 396.1.",DVBABCNT=DVBABCNT+1,^TMP("DVBAR",$J,DVBABCNT)="You must do this before running any reports." S DVBAQUIT=1 H 3 "RTN","DVBAB51",90,0) G:$D(DVBAQUIT) KILL^DVBAUTIL S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ") "RTN","DVBAB51",91,0) S HEAD="INCOMPETENCY REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0) "RTN","DVBAB51",92,0) ;***vm-out*W !,HEAD1 "RTN","DVBAB51",93,0) EN1 ;***vm-out*W !!,"Please enter dates for search, oldest date first, most recent date last.",!!,"Last report was run on " S Y=$P(DTAR,U,5) X ^DD("DD") W Y,!! "RTN","DVBAB51",94,0) ;***vm-out*D DATE^DVBAUTIL G:X=""!(Y<0) KILL "RTN","DVBAB51",95,0) S %ZIS="Q" D ^%ZIS K %ZIS G:POP KILL^DVBAUTIL "RTN","DVBAB51",96,0) ; "RTN","DVBAB51",97,0) QUEUE ;***vm-out*I $D(IO("Q")) S ZTRTN="DEQUE^DVBACMRP",ZTIO=ION,NOASK=1,ZTDESC="AMIE INCOMPETENT VET REPORT" F I="FDT(0)","HEAD","HEAD1","BDATE","EDATE","TYPE","RO","RONUM","NOASK" S ZTSAVE(I)="" "RTN","DVBAB51",98,0) ;***vm-out*I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! G KILL "RTN","DVBAB51",99,0) ; "RTN","DVBAB51",100,0) GO S MA=BDATE F J=0:0 S MA=$O(^DGPM("AMV1",MA)) Q:$P(MA,".")>EDATE!(MA="") F DA=0:0 S DA=$O(^DGPM("AMV1",MA,DA)) Q:DA="" F MB=0:0 S MB=$O(^DGPM("AMV1",MA,DA,MB)) Q:MB="" D SET I '$D(NOASK) W "." "RTN","DVBAB51",101,0) I '$D(^TMP($J)) S ^TMP("DVBAR",$J,DVBABCNT)="No data found for parameters entered." H 2 G KILL "RTN","DVBAB51",102,0) I $D(^TMP($J)) D PRINT K:(DVBAFNLDTE=$P(EDATE,".")) ^XTMP("DVBA_INCOMPETENT_RPT"_$J,0) I $D(DVBAQUIT) K DVBAON2 G KILL^DVBAUTIL "RTN","DVBAB51",103,0) ; "RTN","DVBAB51",104,0) KILL K:(DVBAFNLDTE=$P(EDATE,".")) ^XTMP("DVBA_INCOMPETENT_RPT"_$J,0) "RTN","DVBAB51",105,0) S ZMSG=$NA(^TMP("DVBAR",$J)) "RTN","DVBAB51",106,0) D ^%ZISC S X=5 K DVBAON2 D:$D(ZTQUEUED) KILL^%ZTLOAD G FINAL^DVBAUTIL "RTN","DVBAB51",107,0) Q "RTN","DVBAB51",108,0) ; "RTN","DVBAB51",109,0) DEQUE K ^TMP($J) G GO "RTN","DVBAB51",110,0) ; "RTN","DVBAB51",111,0) COLHDR ;Column header for delimited report "RTN","DVBAB51",112,0) S ^TMP("DVBAR",$J,DVBABCNT)="Patient Name"_DVBADLMTR_"Claim No"_DVBADLMTR_"Claim Folder Loc"_DVBADLMTR "RTN","DVBAB51",113,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Social Sec No"_DVBADLMTR_"Admission Date"_DVBADLMTR "RTN","DVBAB51",114,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Admitting Diagnosis"_DVBADLMTR_"Discharge Date"_DVBADLMTR "RTN","DVBAB51",115,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Type of Discharge"_DVBADLMTR_"Bed Service"_DVBADLMTR "RTN","DVBAB51",116,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Recv A&A?"_DVBADLMTR_"Pension?"_DVBADLMTR "RTN","DVBAB51",117,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Eligibility Data"_DVBADLMTR_"Date Ruled Incomp" "RTN","DVBAB51",118,0) S DVBABCNT=DVBABCNT+1 "RTN","DVBAB51",119,0) S ^XTMP("DVBA_INCOMPETENT_RPT"_$J,0)=DT_U_DT "RTN","DVBAB51",120,0) Q "RTN","DVBAB53") 0^5^B51879016^B45878963 "RTN","DVBAB53",1,0) DVBAB53 ;ALB/SPH - CAPRI DISCHARGE REPORT ; 3/5/12 11:30am "RTN","DVBAB53",2,0) ;;2.7;AMIE;**35,99,100,149,179**;Apr 10, 1995;Build 15 "RTN","DVBAB53",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","DVBAB53",4,0) ; "RTN","DVBAB53",5,0) ;Input: ZMSG - Output Array for discharge report (By Ref) "RTN","DVBAB53",6,0) ; BDATE - Beginning date for eport (FM Format) "RTN","DVBAB53",7,0) ; EDATE - Ending date for report (FM Format) "RTN","DVBAB53",8,0) ; ADTYPE - Valid discharge code values include: "RTN","DVBAB53",9,0) ; A : Recieving A&A "RTN","DVBAB53",10,0) ; P : Pension "RTN","DVBAB53",11,0) ; S : Service Connected "RTN","DVBAB53",12,0) ; L : All discharge types "RTN","DVBAB53",13,0) ; DVBADLMTR - Indicates if report should be delimitted (Optional) "RTN","DVBAB53",14,0) ; CAPRI currently executes RPC by each day in "RTN","DVBAB53",15,0) ; date range, so DVBADLMTR should equal the "RTN","DVBAB53",16,0) ; final EDATE in range so that XTMP global "RTN","DVBAB53",17,0) ; can be killed. "RTN","DVBAB53",18,0) ;Output: ^TMP("DVBAR",$J) contains delimited/non-delimited discharge report "RTN","DVBAB53",19,0) STRT(ZMSG,BDATE,EDATE,ADTYPE,DVBADLMTR) ; "RTN","DVBAB53",20,0) N DVBAFNLDTE,MA1 "RTN","DVBAB53",21,0) I BDATE'["." S BDATE=BDATE-.0001 ; DVBA*2.7*99 "RTN","DVBAB53",22,0) S DVBABCNT=0 "RTN","DVBAB53",23,0) S RONUM=0 "RTN","DVBAB53",24,0) S RO="N" "RTN","DVBAB53",25,0) S HEAD="",HEAD1="" "RTN","DVBAB53",26,0) S DVBAFNLDTE=$S(+$G(DVBADLMTR):+$P(DVBADLMTR,"."),1:0) "RTN","DVBAB53",27,0) S DVBADLMTR=$S('+$G(DVBADLMTR):"",1:"^") "RTN","DVBAB53",28,0) K ^TMP($J) G TERM "RTN","DVBAB53",29,0) ; "RTN","DVBAB53",30,0) SET Q:'$D(^DPT(DA,0)) S DFN=DA,DVBASC="" D RCV^DVBAVDPT Q:CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376) Q:ADTYPE="S"&(DVBASC'="Y") Q:ADTYPE="A"&(RCVAA'=1) Q:ADTYPE="P"&(RCVPEN'="1") "RTN","DVBAB53",31,0) S TDIS=$S($D(^DGPM(+MB,0)):$P(^(0),U,18),1:"") "RTN","DVBAB53",32,0) I $D(^DG(405.2,+TDIS,0)) DO "RTN","DVBAB53",33,0) . ; I '$D(^TMP("DVBA",$J,"DUP",+TDIS)) Q ; DVBA*2.7*99 commented out "RTN","DVBAB53",34,0) .I '$D(DISTYPE(+TDIS)) Q "RTN","DVBAB53",35,0) .S TDIS=$S($P(^DG(405.2,+TDIS,0),U,1)]"":$P(^(0),U,1),1:"Unknown discharge type") "RTN","DVBAB53",36,0) .S MA1=$P(MA,".",1) "RTN","DVBAB53",37,0) .S ^TMP($J,MA1,XCN,CFLOC,MB,DA)=RCVAA_U_RCVPEN_U_CNUM_U_TDIS "RTN","DVBAB53",38,0) .Q "RTN","DVBAB53",39,0) Q "RTN","DVBAB53",40,0) ; "RTN","DVBAB53",41,0) PRINTB S RCVAA=$P(DATA,U),RCVPEN=$P(DATA,U,2),CNUM=$P(DATA,U,3),TDIS=$P(DATA,U,4),DFN=DA,QUIT1=1 D DCHGDT^DVBAVDPT "RTN","DVBAB53",42,0) W:(IOST?1"C-".E)!($D(DVBAON2)) @IOF "RTN","DVBAB53",43,0) W !!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!! "RTN","DVBAB53",44,0) ;create delimited/non-delimited report "RTN","DVBAB53",45,0) D:($G(DVBADLMTR)'="") PRINTD "RTN","DVBAB53",46,0) D:($G(DVBADLMTR)="") PRINTND "RTN","DVBAB53",47,0) Q "RTN","DVBAB53",48,0) ; "RTN","DVBAB53",49,0) PRINTND ;create non-delimited discharge report "RTN","DVBAB53",50,0) S ^TMP("DVBAR",$J,DVBABCNT)="",DVBABCNT=DVBABCNT+1 "RTN","DVBAB53",51,0) ; "RTN","DVBAB53",52,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Patient Name: "_PNAM S DVBABCNT=DVBABCNT+1 "RTN","DVBAB53",53,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Claim No: "_CNUM S DVBABCNT=DVBABCNT+1 "RTN","DVBAB53",54,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Claim Folder Loc: "_CFLOC S DVBABCNT=DVBABCNT+1 "RTN","DVBAB53",55,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Social Sec No: "_SSN S DVBABCNT=DVBABCNT+1 "RTN","DVBAB53",56,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Discharge Date: "_$$FMTE^XLFDT(DCHGDT,"5DZ"),DVBABCNT=DVBABCNT+1 "RTN","DVBAB53",57,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Type of Discharge: "_TDIS,DVBABCNT=DVBABCNT+1 "RTN","DVBAB53",58,0) D LOS^DVBAUTIL "RTN","DVBAB53",59,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Length of Stay: "_LOS_$S(LOS="":"Discharged same day",LOS=1:" day",1:" days"),DVBABCNT=DVBABCNT+1 "RTN","DVBAB53",60,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Bed Service: "_BEDSEC,DVBABCNT=DVBABCNT+1 "RTN","DVBAB53",61,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Recv A&A?: "_$S(RCVAA="0":"NO",RCVAA="1":"YES",1:"Not specified"),DVBABCNT=DVBABCNT+1 "RTN","DVBAB53",62,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Pension?: "_$S(RCVPEN="0":"NO",RCVPEN="1":"YES",1:"Not specified"),DVBABCNT=DVBABCNT+1 "RTN","DVBAB53",63,0) ; "RTN","DVBAB53",64,0) ; "RTN","DVBAB53",65,0) ; ELIG INFO... "RTN","DVBAB53",66,0) S ELIG=DVBAELIG,INCMP="" "RTN","DVBAB53",67,0) ;S ZMSG(DVBABCNT)=" Eligibility data: " "RTN","DVBAB53",68,0) I ELIG]"" S ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")" "RTN","DVBAB53",69,0) I $D(^DPT(DA,.29)) S INCMP=$S($P(^(.29),U,12)=1:"Incompetent",1:"") "RTN","DVBAB53",70,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Eligibility data: "_ELIG_$S(((ELIG]"")&(INCMP]"")):", ",1:"") S DVBABCNT=DVBABCNT+1 "RTN","DVBAB53",71,0) W:$X>60 !?26 S ^TMP("DVBAR",$J,DVBABCNT)=INCMP S DVBABCNT=DVBABCNT+1 "RTN","DVBAB53",72,0) Q "RTN","DVBAB53",73,0) ;END OF ELIG INFO "RTN","DVBAB53",74,0) ; "RTN","DVBAB53",75,0) ;I IOST?1"C-".E W *7,!,"Press RETURN to continue or ""^"" to stop " R ANS:DTIME S:ANS=U!('$T) QUIT=1 I ANS=U S DVBAQUIT=1 "RTN","DVBAB53",76,0) S DVBAON2="" "RTN","DVBAB53",77,0) Q "RTN","DVBAB53",78,0) ; "RTN","DVBAB53",79,0) PRINTD ;create delimited discharge report "RTN","DVBAB53",80,0) N ELIG,INCMP "RTN","DVBAB53",81,0) D:('$D(^XTMP("DVBA_DISCHARGE_RPT"_$J,0))) COLHDR "RTN","DVBAB53",82,0) S ^TMP("DVBAR",$J,DVBABCNT)=PNAM_DVBADLMTR_CNUM_DVBADLMTR_CFLOC_DVBADLMTR_SSN_DVBADLMTR "RTN","DVBAB53",83,0) S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_$$FMTE^XLFDT(DCHGDT,"5DZ")_DVBADLMTR_TDIS_DVBADLMTR "RTN","DVBAB53",84,0) D LOS^DVBAUTIL "RTN","DVBAB53",85,0) S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_LOS_$S(LOS="":"Discharged same day",LOS=1:" day",1:" days")_DVBADLMTR "RTN","DVBAB53",86,0) S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_BEDSEC_DVBADLMTR_$S(RCVAA="0":"NO",RCVAA="1":"YES",1:"Not specified")_DVBADLMTR "RTN","DVBAB53",87,0) S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_$S(RCVPEN="0":"NO",RCVPEN="1":"YES",1:"Not specified")_DVBADLMTR "RTN","DVBAB53",88,0) ; "RTN","DVBAB53",89,0) S ELIG=DVBAELIG,INCMP="" "RTN","DVBAB53",90,0) I ELIG]"" S ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")" "RTN","DVBAB53",91,0) I $D(^DPT(DA,.29)) S INCMP=$S($P(^(.29),U,12)=1:"Incompetent",1:"") "RTN","DVBAB53",92,0) ; "RTN","DVBAB53",93,0) S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_ELIG_$S(((ELIG]"")&(INCMP]"")):", ",1:"")_INCMP "RTN","DVBAB53",94,0) S DVBABCNT=DVBABCNT+1 "RTN","DVBAB53",95,0) Q "RTN","DVBAB53",96,0) ; "RTN","DVBAB53",97,0) PRINT U IO S QUIT="" "RTN","DVBAB53",98,0) S MA="" F G=0:0 S MA=$O(^TMP($J,MA)) Q:MA=""!(QUIT=1) S XCN="" F M=0:0 S XCN=$O(^TMP($J,MA,XCN)) Q:XCN=""!(QUIT=1) S CFLOC="" F J=0:0 S CFLOC=$O(^TMP($J,MA,XCN,CFLOC)) Q:CFLOC=""!(QUIT=1) D PRINT1 "RTN","DVBAB53",99,0) Q "RTN","DVBAB53",100,0) PRINT1 S ADM="" F K=0:0 S ADM=$O(^TMP($J,MA,XCN,CFLOC,ADM)) Q:ADM=""!(QUIT=1) S DA="" F L=0:0 S DA=$O(^TMP($J,MA,XCN,CFLOC,ADM,DA)) Q:DA=""!(QUIT=1) S DATA=^(DA) D PRINTB "RTN","DVBAB53",101,0) Q "RTN","DVBAB53",102,0) ; "RTN","DVBAB53",103,0) TERM ;D HOME^%ZIS K NOASK "RTN","DVBAB53",104,0) ; "RTN","DVBAB53",105,0) SETUP ;W @IOF,!,"VARO DISCHARGE REPORT" D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ") "RTN","DVBAB53",106,0) S DSRP=1 "RTN","DVBAB53",107,0) ;S HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0) W !,HEAD1 "RTN","DVBAB53",108,0) ; "RTN","DVBAB53",109,0) EN1 ;W !!,"Please enter dates for search, oldest date first, most recent date last.",!!,"Last report was run on " S Y=$P(DTAR,U,4) X ^DD("DD") W Y,!! "RTN","DVBAB53",110,0) ;D DATE^DVBAUTIL "RTN","DVBAB53",111,0) ;G:X=""!(Y<0) KILL "RTN","DVBAB53",112,0) ; "RTN","DVBAB53",113,0) ADTYPE ;D ADTYPE^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL "RTN","DVBAB53",114,0) ;W @IOF "RTN","DVBAB53",115,0) ;K DVBACEPT "RTN","DVBAB53",116,0) D EN^DVBAB99("DVBA DISCHARGE TYPES") "RTN","DVBAB53",117,0) D ACCEPT^DVBALD "RTN","DVBAB53",118,0) I '$D(DVBACEPT) D KILL^DVBAUTIL Q "RTN","DVBAB53",119,0) I '$O(^TMP("DVBA",$J,"DUP",0)) D KILL^DVBAUTIL Q "RTN","DVBAB53",120,0) M DISTYPE=^TMP("DVBA",$J,"DUP") "RTN","DVBAB53",121,0) ; "RTN","DVBAB53",122,0) ; DVBA*2.7*100 - commented out next line "RTN","DVBAB53",123,0) ; W !!! S %ZIS="Q" D ^%ZIS K %ZIS G:POP KILL^DVBAUTIL "RTN","DVBAB53",124,0) ; "RTN","DVBAB53",125,0) QUEUE I $D(IO("Q")) S ZTRTN="DEQUE^DVBADSRT",ZTIO=ION,NOASK=1,ZTDESC="AMIE DISCHARGE REPORT" F I="DISTYPE(","ADTYPE","DVBATYPS","BDATE","BDATE1","EDATE","FDT(0)","HEAD","HEAD1","HD","RO","RONUM","NOASK" S ZTSAVE(I)="" "RTN","DVBAB53",126,0) I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",! G KILL "RTN","DVBAB53",127,0) ; "RTN","DVBAB53",128,0) GO S MA=BDATE F J=0:0 S MA=$O(^DGPM("AMV3",MA)) Q:MA>EDATE!(MA="") W:'$D(NOASK) "." F DA=0:0 S DA=$O(^DGPM("AMV3",MA,DA)) Q:DA="" F MB=0:0 S MB=$O(^DGPM("AMV3",MA,DA,MB)) Q:MB="" D SET "RTN","DVBAB53",129,0) I '$D(^TMP($J)) D H 2 G KILL "RTN","DVBAB53",130,0) .N DVBAERTXT S DVBAERTXT="No data found for parameters entered." "RTN","DVBAB53",131,0) .U IO W !!,*7,DVBAERTXT,!! "RTN","DVBAB53",132,0) .S:($G(DVBADLMTR)'="") ^TMP("DVBAR",$J,DVBABCNT)=DVBAERTXT "RTN","DVBAB53",133,0) D PRINT K:(DVBAFNLDTE=$P(EDATE,".")) ^XTMP("DVBA_DISCHARGE_RPT"_$J,0) "RTN","DVBAB53",134,0) I $D(DVBAQUIT) K DVBAON2,DISTYPE G KILL^DVBAUTIL "RTN","DVBAB53",135,0) ; "RTN","DVBAB53",136,0) KILL K:(DVBAFNLDTE=$P(EDATE,".")) ^XTMP("DVBA_DISCHARGE_RPT"_$J,0) "RTN","DVBAB53",137,0) S ZMSG=$NA(^TMP("DVBAR",$J)) "RTN","DVBAB53",138,0) D ^%ZISC D:$D(ZTQUEUED) KILL^%ZTLOAD S X=4 K DVBAON2,DISTYPE G FINAL^DVBAUTIL "RTN","DVBAB53",139,0) ; "RTN","DVBAB53",140,0) DEQUE K ^TMP($J) G GO "RTN","DVBAB53",141,0) ; "RTN","DVBAB53",142,0) COLHDR ;Column header for delimited report "RTN","DVBAB53",143,0) S ^TMP("DVBAR",$J,DVBABCNT)="Patient Name"_DVBADLMTR_"Claim No"_DVBADLMTR_"Claim Folder Loc"_DVBADLMTR "RTN","DVBAB53",144,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Social Sec No"_DVBADLMTR_"Discharge Date"_DVBADLMTR "RTN","DVBAB53",145,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Type of Discharge"_DVBADLMTR_"Length of Stay"_DVBADLMTR "RTN","DVBAB53",146,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Bed Service"_DVBADLMTR_"Recv A&A?"_DVBADLMTR "RTN","DVBAB53",147,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Pension?"_DVBADLMTR_"Eligibility Data" "RTN","DVBAB53",148,0) S DVBABCNT=DVBABCNT+1 "RTN","DVBAB53",149,0) ;set global entry so header is only created once for job ($J) "RTN","DVBAB53",150,0) S ^XTMP("DVBA_DISCHARGE_RPT"_$J,0)=DT_U_DT_U_BDATE_U_EDATE "RTN","DVBAB53",151,0) Q "RTN","DVBAB54") 0^6^B35153355^B30133216 "RTN","DVBAB54",1,0) DVBAB54 ;ALB/VM - CAPRI ADMISSION REPORT ; 3/5/12 11:31am "RTN","DVBAB54",2,0) ;;2.7;AMIE;**35,149,179**;Apr 10, 1995;Build 15 "RTN","DVBAB54",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","DVBAB54",4,0) ; "RTN","DVBAB54",5,0) ;Input: ZMSG - Output Array for SC Veteran Admission report (By Ref) "RTN","DVBAB54",6,0) ; BDATE - Beginning date for eport (FM Format) "RTN","DVBAB54",7,0) ; EDATE - Ending date for report (FM Format) "RTN","DVBAB54",8,0) ; DVBADLMTR - Indicates if report should be delimited (Optional) "RTN","DVBAB54",9,0) ; CAPRI currently executes RPC by each day in "RTN","DVBAB54",10,0) ; date range, so DVBADLMTR should equal the "RTN","DVBAB54",11,0) ; final EDATE in range so that XTMP global "RTN","DVBAB54",12,0) ; can be killed. "RTN","DVBAB54",13,0) ;Output: ^TMP("DVBAR",$J) contains delimited/non-delimited SC Veteran Admission report "RTN","DVBAB54",14,0) STRT(ZMSG,BDATE,EDATE,DVBADLMTR) ;ENTER HERE "RTN","DVBAB54",15,0) N DVBAFNLDTE,MA1 "RTN","DVBAB54",16,0) S DVBABCNT=0,RO="N",RONUM=0 "RTN","DVBAB54",17,0) S DVBAFNLDTE=$S(+$G(DVBADLMTR):+$P(DVBADLMTR,"."),1:0) "RTN","DVBAB54",18,0) S DVBADLMTR=$S('+$G(DVBADLMTR):"",1:"^") "RTN","DVBAB54",19,0) K ^TMP($J) G TERM "RTN","DVBAB54",20,0) SET Q:'$D(^DPT(DA,0)) S DFN=DA,DVBASC="" D SC^DVBAVDPT Q:DVBASC'="Y" Q:CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376) S MA1=$P(MA,".",1),^TMP($J,MA1,XCN,CFLOC,MB,DA)=MA "RTN","DVBAB54",21,0) Q "RTN","DVBAB54",22,0) ; "RTN","DVBAB54",23,0) PRINTB S ADMDT=$P(DATA,U),DFN=DA D ADM^DVBAVDPT "RTN","DVBAB54",24,0) ;W:(IOST?1"C-".E)!($D(DVBAON2)) @IOF "RTN","DVBAB54",25,0) ;W !!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!! "RTN","DVBAB54",26,0) S:ADMDT]"" ADMDT=$E(ADMDT,4,5)_"/"_$E(ADMDT,6,7)_"/"_$E(ADMDT,2,3) S:DCHGDT]"" DCHGDT=$E(DCHGDT,4,5)_"/"_$E(DCHGDT,6,7)_"/"_$E(DCHGDT,2,3) "RTN","DVBAB54",27,0) ;create delimited/non-delimited report "RTN","DVBAB54",28,0) D:($G(DVBADLMTR)'="") PRINTD "RTN","DVBAB54",29,0) D:($G(DVBADLMTR)="") PRINTND "RTN","DVBAB54",30,0) S DVBAON2="" "RTN","DVBAB54",31,0) Q "RTN","DVBAB54",32,0) ; "RTN","DVBAB54",33,0) PRINTND ;create non-delimited admission report "RTN","DVBAB54",34,0) S ^TMP("DVBAR",$J,DVBABCNT)="",DVBABCNT=DVBABCNT+1 "RTN","DVBAB54",35,0) S ^TMP("DVBAR",$J,DVBABCNT)="",DVBABCNT=DVBABCNT+1 "RTN","DVBAB54",36,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Patient Name: "_PNAM,DVBABCNT=DVBABCNT+1 "RTN","DVBAB54",37,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Claim No: "_CNUM,DVBABCNT=DVBABCNT+1 "RTN","DVBAB54",38,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Claim Folder Loc: "_CFLOC,DVBABCNT=DVBABCNT+1 "RTN","DVBAB54",39,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Social Sec No: "_SSN,DVBABCNT=DVBABCNT+1 "RTN","DVBAB54",40,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Admission Date: "_ADMDT,DVBABCNT=DVBABCNT+1 "RTN","DVBAB54",41,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Admitting Diagnosis: "_DIAG,DVBABCNT=DVBABCNT+1 "RTN","DVBAB54",42,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Discharge Date: "_DCHGDT,DVBABCNT=DVBABCNT+1 "RTN","DVBAB54",43,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Bed Service: "_BEDSEC,DVBABCNT=DVBABCNT+1 "RTN","DVBAB54",44,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Recv A&A?: "_$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified"),DVBABCNT=DVBABCNT+1 "RTN","DVBAB54",45,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Pension?: "_$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified"),DVBABCNT=DVBABCNT+1 "RTN","DVBAB54",46,0) ;D ELIG^DVBAVDPT "RTN","DVBAB54",47,0) ELIG S ELIG=DVBAELIG,INCMP="" "RTN","DVBAB54",48,0) I ELIG]"" S ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")" "RTN","DVBAB54",49,0) I $D(^DPT(DA,.29)) S INCMP=$S($P(^(.29),U,12)=1:"Incompetent",1:"") "RTN","DVBAB54",50,0) S ^TMP("DVBAR",$J,DVBABCNT)=" Eligibility data: "_ELIG_$S(((ELIG]"")&(INCMP]"")):", ",1:""),DVBABCNT=DVBABCNT+1 "RTN","DVBAB54",51,0) I $X>60 S ^TMP("DVBAR",$J,DVBABCNT)=INCMP,DVBABCNT=DVBABCNT+1 "RTN","DVBAB54",52,0) ;Q "RTN","DVBAB54",53,0) ;***VM-OUT*I IOST?1"C-".E W *7,!,"Press RETURN to continue or ""^"" to stop " R ANS:DTIME S:ANS=U!('$T) QUIT=1 I '$T S DVBAQUIT=1 "RTN","DVBAB54",54,0) Q "RTN","DVBAB54",55,0) ; "RTN","DVBAB54",56,0) PRINTD ;create delimited admission report "RTN","DVBAB54",57,0) N ELIG,INCMP "RTN","DVBAB54",58,0) D:('$D(^XTMP("DVBA_SCADMSSN_RPT"_$J,0))) COLHDR "RTN","DVBAB54",59,0) S ^TMP("DVBAR",$J,DVBABCNT)=PNAM_DVBADLMTR_CNUM_DVBADLMTR_CFLOC_DVBADLMTR_SSN_DVBADLMTR_ADMDT_DVBADLMTR "RTN","DVBAB54",60,0) S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_DIAG_DVBADLMTR_DCHGDT_DVBADLMTR_BEDSEC_DVBADLMTR "RTN","DVBAB54",61,0) S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified")_DVBADLMTR "RTN","DVBAB54",62,0) S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified")_DVBADLMTR "RTN","DVBAB54",63,0) S ELIG=DVBAELIG,INCMP="" "RTN","DVBAB54",64,0) I ELIG]"" S ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")" "RTN","DVBAB54",65,0) I $D(^DPT(DA,.29)) S INCMP=$S($P(^(.29),U,12)=1:"Incompetent",1:"") "RTN","DVBAB54",66,0) S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_ELIG_$S(((ELIG]"")&(INCMP]"")):", ",1:"")_INCMP "RTN","DVBAB54",67,0) S DVBABCNT=DVBABCNT+1 "RTN","DVBAB54",68,0) Q "RTN","DVBAB54",69,0) ; "RTN","DVBAB54",70,0) PRINT K MA S QUIT="" "RTN","DVBAB54",71,0) S MA="" F G=0:0 S MA=$O(^TMP($J,MA)) Q:MA=""!(QUIT=1) S XCN="" F M=0:0 S XCN=$O(^TMP($J,MA,XCN)) Q:XCN=""!(QUIT=1) S CFLOC="" F J=0:0 S CFLOC=$O(^TMP($J,MA,XCN,CFLOC)) Q:CFLOC=""!(QUIT=1) D PRINT1 "RTN","DVBAB54",72,0) Q "RTN","DVBAB54",73,0) PRINT1 S ADM="" F K=0:0 S ADM=$O(^TMP($J,MA,XCN,CFLOC,ADM)) Q:ADM=""!(QUIT=1) S DA="" F L=0:0 S DA=$O(^TMP($J,MA,XCN,CFLOC,ADM,DA)) Q:DA=""!(QUIT=1) S DATA=^(DA) D PRINTB "RTN","DVBAB54",74,0) Q "RTN","DVBAB54",75,0) ; "RTN","DVBAB54",76,0) TERM ;D HOME^%ZIS K NOASK "RTN","DVBAB54",77,0) ; "RTN","DVBAB54",78,0) ;W @IOF,!,"VARO SERVICE-CONNECTED ADMISSION REPORT" D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL "RTN","DVBAB54",79,0) S DTAR=^DVB(396.1,1,0),FDT(0)=$E(DT,4,5)_"-"_$E(DT,6,7)_"-"_$E(DT,2,3) "RTN","DVBAB54",80,0) S HEAD="SERVICE-CONNECTED ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0) "RTN","DVBAB54",81,0) ;W !,HEAD1 "RTN","DVBAB54",82,0) ;W !!,"Please enter dates for search, oldest date first, most recent date last.",!!,"Last report was run on " S Y=$P(DTAR,U,8) X ^DD("DD") W Y,!! "RTN","DVBAB54",83,0) ;D DATE^DVBAUTIL "RTN","DVBAB54",84,0) ;G:X=""!(Y<0) KILL "RTN","DVBAB54",85,0) ;S %ZIS="Q" D ^%ZIS K %ZIS G:POP KILL^DVBAUTIL "RTN","DVBAB54",86,0) ; "RTN","DVBAB54",87,0) ;I $D(IO("Q")) S ZTRTN="DEQUE^DVBASCRP",ZTIO=ION,NOASK=1,ZTDESC="AMIE SC ADMISSION REPORT" F I="FDT(0)","HEAD","HEAD1","BDATE","EDATE","TYPE","RO","RONUM","NOASK" S ZTSAVE(I)="" "RTN","DVBAB54",88,0) ;I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued.",!! G KILL "RTN","DVBAB54",89,0) ; "RTN","DVBAB54",90,0) GO S MA=BDATE F J=0:0 S MA=$O(^DGPM("AMV1",MA)) Q:$P(MA,".")>EDATE!(MA="") F DA=0:0 S DA=$O(^DGPM("AMV1",MA,DA)) Q:DA="" F MB=0:0 S MB=$O(^DGPM("AMV1",MA,DA,MB)) Q:MB="" D SET W:'$D(NOASK) "." "RTN","DVBAB54",91,0) I '$D(^TMP($J)) S ^TMP("DVBAR",$J,DVBABCNT)="No data found for parameters entered." H 2 G KILL "RTN","DVBAB54",92,0) D PRINT K:(DVBAFNLDTE=$P(EDATE,".")) ^XTMP("DVBA_SCADMSSN_RPT"_$J,0) "RTN","DVBAB54",93,0) I $D(DVBAQUIT) K DVBAON2 D:$D(ZTQUEUED) KILL^%ZTLOAD G KILL^DVBAUTIL "RTN","DVBAB54",94,0) ; "RTN","DVBAB54",95,0) KILL K:(DVBAFNLDTE=$P(EDATE,".")) ^XTMP("DVBA_SCADMSSN_RPT"_$J,0) "RTN","DVBAB54",96,0) S ZMSG=$NA(^TMP("DVBAR",$J)) "RTN","DVBAB54",97,0) D:$D(ZTQUEUED) KILL^%ZTLOAD D ^%ZISC S X=8 K DVBAON2 G FINAL^DVBAUTIL "RTN","DVBAB54",98,0) ; "RTN","DVBAB54",99,0) DEQUE K ^TMP($J) G GO "RTN","DVBAB54",100,0) ; "RTN","DVBAB54",101,0) COLHDR ;Column header for delimited report "RTN","DVBAB54",102,0) S ^TMP("DVBAR",$J,DVBABCNT)="Patient Name"_DVBADLMTR_"Claim No"_DVBADLMTR_"Claim Folder Loc"_DVBADLMTR "RTN","DVBAB54",103,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Social Sec No"_DVBADLMTR_"Admission Date"_DVBADLMTR "RTN","DVBAB54",104,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Admitting Diagnosis"_DVBADLMTR_"Discharge Date"_DVBADLMTR "RTN","DVBAB54",105,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Bed Service"_DVBADLMTR_"Recv A&A?"_DVBADLMTR "RTN","DVBAB54",106,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Pension?"_DVBADLMTR_"Eligibility Data" "RTN","DVBAB54",107,0) S DVBABCNT=DVBABCNT+1 "RTN","DVBAB54",108,0) ;set global entry so header is only created once for job ($J) "RTN","DVBAB54",109,0) S ^XTMP("DVBA_SCADMSSN_RPT"_$J,0)=DT_U_DT "RTN","DVBAB54",110,0) Q "RTN","DVBAB56") 0^7^B25277073^B24628055 "RTN","DVBAB56",1,0) DVBAB56 ;ALB/SPH - CAPRI READMISSION REPORT ; 3/22/12 8:34am "RTN","DVBAB56",2,0) ;;2.7;AMIE;**35,149,179**;Apr 10, 1995;Build 15 "RTN","DVBAB56",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","DVBAB56",4,0) ; "RTN","DVBAB56",5,0) ;Input: ZMSG - Output Array for Re-Admission report (By Ref) "RTN","DVBAB56",6,0) ; BDATE - Beginning date for eport (FM Format) "RTN","DVBAB56",7,0) ; EDATE - Ending date for report (FM Format) "RTN","DVBAB56",8,0) ; DVBAH - Specifies Hospital (H) or DOM (D) "RTN","DVBAB56",9,0) ; DVBADLMTR - Indicates if report should be delimitted (Optional) "RTN","DVBAB56",10,0) ; CAPRI currently executes RPC by each day in "RTN","DVBAB56",11,0) ; date range, so DVBADLMTR should equal the "RTN","DVBAB56",12,0) ; final EDATE in range so that XTMP global "RTN","DVBAB56",13,0) ; can be killed. "RTN","DVBAB56",14,0) ;Output: ^TMP("DVBAR",$J) contains delimited/non-delimited re-admission report "RTN","DVBAB56",15,0) STRT(ZMSG,BDATE,EDATE,DVBAH,DVBADLMTR) ; "RTN","DVBAB56",16,0) N DVBAFNLDTE,SORTDT "RTN","DVBAB56",17,0) S DVBAFNLDTE=$S(+$G(DVBADLMTR):+$P(DVBADLMTR,"."),1:0) "RTN","DVBAB56",18,0) S DVBADLMTR=$S('+$G(DVBADLMTR):"",1:"^") "RTN","DVBAB56",19,0) S DVBABCNT=0 "RTN","DVBAB56",20,0) G TERM "RTN","DVBAB56",21,0) SORT D RCV^DVBAVDPT I $D(RONUM),$D(RO) Q:CFLOC'=RONUM&(RO="Y") "RTN","DVBAB56",22,0) I RCVAA S ^TMP("DVBA",$J,"A&A",DFN)=DVBADT "RTN","DVBAB56",23,0) I RCVPEN S ^TMP("DVBA",$J,"PEN",DFN)=DVBADT "RTN","DVBAB56",24,0) Q "RTN","DVBAB56",25,0) ; "RTN","DVBAB56",26,0) DCHGDT S (LADMDT,LDCHGDT)="",DCHPTR=$P(^DGPM(VY,0),U,17),LADMDT=$P(^(0),U,1) I DCHPTR]"",$D(^DGPM(+DCHPTR,0)) S LDCHGDT=$P(^DGPM(+DCHPTR,0),U,1) "RTN","DVBAB56",27,0) Q "RTN","DVBAB56",28,0) ; "RTN","DVBAB56",29,0) CAL S I="",ZI=1 F DVBAI=0:0 S I=$O(^DGPM("APID",DFN,I)) Q:I="" F J=0:0 S J=$O(^DGPM("APID",DFN,I,J)) Q:J="" S ZJ=$S($D(^DGPM(J,0)):^(0),1:"") I $P(ZJ,U,1)'>EDATE,$P(ZJ,U,2)=1 S ^TMP("DVBA",$J,"ADM",DFN,ZI,J)="",ZI=ZI+1 "RTN","DVBAB56",30,0) S VX=$O(^TMP("DVBA",$J,"ADM",DFN,1,0)) Q:VX="" S CURADMDT=$P(^DGPM(VX,0),U,1) Q:CURADMDT="" "RTN","DVBAB56",31,0) F VX=1:1 S VX=$O(^TMP("DVBA",$J,"ADM",DFN,VX)) Q:VX="" F VY=0:0 S VY=$O(^TMP("DVBA",$J,"ADM",DFN,VX,VY)) Q:VY="" D DCHGDT I CURADMDT["."&(LADMDT[".") D SET "RTN","DVBAB56",32,0) Q "RTN","DVBAB56",33,0) TDIS S TDIS=$S($D(^DGPM(+DCHPTR,0)):$P(^(0),U,18),1:"") Q:TDIS="" "RTN","DVBAB56",34,0) S:'$D(^DG(405.2,+TDIS,0)) TDIS="Unknown discharge type" I $D(^(0)) S TDIS=$S($P(^DG(405.2,+TDIS,0),U,1)]"":$P(^(0),U,1),1:"Unknown discharge type") "RTN","DVBAB56",35,0) Q "RTN","DVBAB56",36,0) ; "RTN","DVBAB56",37,0) SET S X1=CURADMDT,X2=LDCHGDT D ^%DTC Q:X>185 "RTN","DVBAB56",38,0) S X2=LADMDT,X1=LDCHGDT D ^%DTC S LOS=X Q:LOS'>HOSPDAYS "RTN","DVBAB56",39,0) I DVBAT="A&A" DO ;**Check last admission for A&A vet "RTN","DVBAB56",40,0) .S ADMDT=LADMDT "RTN","DVBAB56",41,0) .D ADM^DVBAVDPT,TDIS "RTN","DVBAB56",42,0) .I TDIS["IRREGULAR" DO ;**Irregular discharge, set last admis info "RTN","DVBAB56",43,0) ..S ^TMP("DVBA",DVBAT,$J,SORTDT,XCN,CFLOC,VY,DFN,"LADM")=LADMDT_U_TDIS "RTN","DVBAB56",44,0) I $D(TDIS),(TDIS'["IRREGULAR"&(DVBAT="A&A")) Q ;**Quit "RTN","DVBAB56",45,0) S ADMDT=CURADMDT "RTN","DVBAB56",46,0) D ADM^DVBAVDPT,TDIS "RTN","DVBAB56",47,0) ; **Set current admis info "RTN","DVBAB56",48,0) S ^TMP("DVBA",DVBAT,$J,SORTDT,XCN,CFLOC,VY,DFN)=CURADMDT_U_RCVAA_U_RCVPEN_U_CNUM_U_TDIS "RTN","DVBAB56",49,0) I DVBAT="PEN" DO ;**Set last admis info for Pension vet "RTN","DVBAB56",50,0) .S ADMDT=LADMDT "RTN","DVBAB56",51,0) .D ADM^DVBAVDPT,TDIS "RTN","DVBAB56",52,0) .S ^TMP("DVBA",DVBAT,$J,SORTDT,XCN,CFLOC,VY,DFN,"LADM")=LADMDT_U_TDIS "RTN","DVBAB56",53,0) K DVBARADQ "RTN","DVBAB56",54,0) S (VX,VY)=9999999 "RTN","DVBAB56",55,0) Q "RTN","DVBAB56",56,0) ; "RTN","DVBAB56",57,0) TERM ;D HOME^%ZIS "RTN","DVBAB56",58,0) K ^TMP("DVBA",$J),^TMP("DVBA","PEN",$J),^TMP("DVBA","A&A",$J),NOASK "RTN","DVBAB56",59,0) ;D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) KILL^DVBAUTIL "RTN","DVBAB56",60,0) ; "RTN","DVBAB56",61,0) SETUP ;W @IOF,!,"VARO RE-ADMISSION REPORT" "RTN","DVBAB56",62,0) S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ") "RTN","DVBAB56",63,0) S HEAD="RE-ADMISSION REPORT",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0) "RTN","DVBAB56",64,0) ;W !,HEAD1 "RTN","DVBAB56",65,0) EN1 ;W !!,"Please enter admission dates for search, oldest date first,",!,"most recent date last.",!!,"Last report was run on " S Y=$P(DTAR,U,7) X ^DD("DD") W Y,!! "RTN","DVBAB56",66,0) ;D DATE^DVBAUTIL G:Y<0 KILL^DVBAUTIL "RTN","DVBAB56",67,0) S BDATE1=BDATE+.5,HEADDT="Date range: "_$$FMTE^XLFDT(BDATE1,"5DZ")_" to "_$$FMTE^XLFDT(EDATE,"5DZ") "RTN","DVBAB56",68,0) ; "RTN","DVBAB56",69,0) ASK ;W !!,"Do you want (H)ospital or Hospital-(D)om H// " R DVBAH:DTIME G:'$T!(DVBAH=U) KILL^DVBAUTIL "RTN","DVBAB56",70,0) I DVBAH="" S DVBAH="H" W DVBAH "RTN","DVBAB56",71,0) S:DVBAH="d" DVBAH="D" "RTN","DVBAB56",72,0) S:DVBAH="h" DVBAH="H" "RTN","DVBAB56",73,0) I DVBAH'?1"H"&(DVBAH'?1"D") W *7,!!,"Must be H for HOSPITAL or D for HOSPITAL-DOM",!! H 3 G ASK "RTN","DVBAB56",74,0) S HEAD=HEAD_" ("_$S(DVBAH="H":"Hospital",DVBAH="D":"Hospital-Dom",1:"Unknown selection")_")" "RTN","DVBAB56",75,0) S Z=$S(DVBAH="D":1,DVBAH="H":2,1:0) W $P("Dom^Hospital",U,Z),!! "RTN","DVBAB56",76,0) ;S %ZIS("B")="0;P-OTHER",%ZIS("A")="Printing device: ",%ZIS="AEQ" D ^%ZIS G:POP KILL^DVBAUTIL "RTN","DVBAB56",77,0) I $D(IO("Q")) F I="NOASK","HEAD*","FDT(0)","DTAR","BDATE*","EDATE*","DVBAH" S ZTSAVE(I)="" "RTN","DVBAB56",78,0) I S NOASK=1,ZTRTN="DQ^DVBARADM",ZTDESC="AMIE Re-admission Report",ZTIO=ION D ^%ZTLOAD W:$D(ZTSK) !,"Request queued.",!! G KILL^DVBAUTIL "RTN","DVBAB56",79,0) GO I '$D(NOASK) W !!,"Looking for Pension and A&A cases ...",!! "RTN","DVBAB56",80,0) F DVBADT=BDATE:0 S DVBADT=$O(^DGPM("AMV1",DVBADT)) Q:DVBADT=""!(DVBADT>EDATE) W:'$D(NOASK) "." F DFN=0:0 S DFN=$O(^DGPM("AMV1",DVBADT,DFN)) Q:DFN="" F ADM=0:0 S ADM=$O(^DGPM("AMV1",DVBADT,DFN,ADM)) Q:ADM="" D SORT "RTN","DVBAB56",81,0) I '$D(NOASK) W !!,"Examining cases found for re-admissions within 185 days ...",!! "RTN","DVBAB56",82,0) F DVBAT="PEN","A&A" S HOSPDAYS=$S(DVBAT="PEN"&(DVBAH="H"):89,DVBAT="PEN"&(DVBAH="D"):59,1:29) F DFN=0:0 S DFN=$O(^TMP("DVBA",$J,DVBAT,DFN)) Q:DFN="" S SORTDT=^(DFN) D CAL W:'$D(NOASK) "+" "RTN","DVBAB56",83,0) K ^TMP("DVBA",$J,"PEN"),^TMP("DVBA",$J,"A&A") "RTN","DVBAB56",84,0) I '$D(^TMP("DVBA","PEN",$J))&('$D(^TMP("DVBA","A&A",$J))) D H 2 D:$D(ZTQUEUED) KILL^%ZTLOAD G KILL^DVBAUTIL "RTN","DVBAB56",85,0) .N DVBAERTXT S DVBAERTXT="No data found for parameters entered." "RTN","DVBAB56",86,0) .W DVBAERTXT S:($G(DVBADLMTR)'="") ^TMP("DVBAR",$J,DVBABCNT)=DVBAERTXT "RTN","DVBAB56",87,0) G ^DVBAB98 "RTN","DVBAB56",88,0) ; "RTN","DVBAB56",89,0) DQ K ^TMP("DVBA",$J),^TMP("DVBA","PEN",$J),^TMP("DVBA","A&A",$J) "RTN","DVBAB56",90,0) G GO "RTN","DVBAB82") 0^3^B109260107^B101314855 "RTN","DVBAB82",1,0) DVBAB82 ;ALB - CAPRI DVBA REPORTS ; 01/24/12 "RTN","DVBAB82",2,0) ;;2.7;AMIE;**42,90,100,119,156,149,179**;Apr 10, 1995;Build 15 "RTN","DVBAB82",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","DVBAB82",4,0) Q "RTN","DVBAB82",5,0) ; "RTN","DVBAB82",6,0) START(MSG,RPID,PARM) ; CALLED BY REMOTE PROCEDURE DVBAB REPORTS "RTN","DVBAB82",7,0) ;Parameters "RTN","DVBAB82",8,0) ;============= "RTN","DVBAB82",9,0) ; MSG : Output - ^TMP("DVBA",$J) "RTN","DVBAB82",10,0) ; RPID : Report Identification Number "RTN","DVBAB82",11,0) ; PARM : Input parameters separated by "^" "RTN","DVBAB82",12,0) ; "RTN","DVBAB82",13,0) N DVBHFS,DVBERR,DVBGUI,I,DVBADLMTD "RTN","DVBAB82",14,0) K ^TMP("DVBA",$J) "RTN","DVBAB82",15,0) S DVBGUI=1,(DVBERR,DVBADLMTD)=0,DVBHFS=$$HFS(),RPID=$G(RPID) "RTN","DVBAB82",16,0) I RPID<1!(RPID>14) S DVBERR=1,^TMP("DVBA",$J,1)="0^Undefined Report ID" G END "RTN","DVBAB82",17,0) D HFSOPEN("DVBRP",DVBHFS,"W") I DVBERR G END "RTN","DVBAB82",18,0) I RPID=1 D CRMS G END "RTN","DVBAB82",19,0) I RPID=3 D CPRNT G END "RTN","DVBAB82",20,0) I RPID=11 D CNHRP G END ;FNCNH Print Roster "RTN","DVBAB82",21,0) D CHECK I DVBERR G END ;reports below require parameters "RTN","DVBAB82",22,0) I RPID=2 D CRRR G END "RTN","DVBAB82",23,0) I RPID=4 D CRPON G END "RTN","DVBAB82",24,0) I RPID=5 D CIRPT G END "RTN","DVBAB82",25,0) I RPID=6 D DSRP G END "RTN","DVBAB82",26,0) I RPID=7 D SDPP G END "RTN","DVBAB82",27,0) I RPID=8 D SPRPT G END "RTN","DVBAB82",28,0) I RPID=9 D VIEW G END "RTN","DVBAB82",29,0) I RPID=10 D CNHDEOC G END ;FBCNH Display Episode Of Care "RTN","DVBAB82",30,0) I RPID=12 D CNHRAD G END ;FNCNH Report of Admissions/Discharges "RTN","DVBAB82",31,0) I RPID=13 D CNHSE90D G END ;FNCNH Stays in Excess of 90 Days "RTN","DVBAB82",32,0) I RPID=14 D REQSTAT G END ;REQUEST STATUS BY DATE RANGE "RTN","DVBAB82",33,0) ; "RTN","DVBAB82",34,0) END D HFSCLOSE("DVBRP",DVBHFS) "RTN","DVBAB82",35,0) I ($G(DVBADLMTD)&('+DVBERR)) D Q ;Create delimited output if no errors "RTN","DVBAB82",36,0) .D DLMTRPT^DVBAB82D(RPID) "RTN","DVBAB82",37,0) .S MSG=$NA(^TMP("DVBADLMTD",$J)) "RTN","DVBAB82",38,0) ;Replace "##FFFF##" with Form Feeds - code needed for LINUX environments "RTN","DVBAB82",39,0) S I=0 F S I=$O(^TMP("DVBA",$J,1,I)) Q:'I D "RTN","DVBAB82",40,0) .S:^TMP("DVBA",$J,1,I)["##FFFF##" ^TMP("DVBA",$J,1,I)=$P(^TMP("DVBA",$J,1,I),"##FFFF##")_$C(13,12)_$P(^TMP("DVBA",$J,1,I),"##FFFF##",2) "RTN","DVBAB82",41,0) .S ^TMP("DVBA",$J,1,I)=^TMP("DVBA",$J,1,I)_$C(13) "RTN","DVBAB82",42,0) .S:^TMP("DVBA",$J,1,I)["$END" ^TMP("DVBA",$J,1,I)="" "RTN","DVBAB82",43,0) S MSG=$NA(^TMP("DVBA",$J)) "RTN","DVBAB82",44,0) Q "RTN","DVBAB82",45,0) CHECK ; VALIDATE INPUT PARAMETERS "RTN","DVBAB82",46,0) I $G(PARM)="" S DVBERR=1,^TMP("DVBA",$J,1)="0^Undefined Input Parameters" "RTN","DVBAB82",47,0) Q "RTN","DVBAB82",48,0) ; "RTN","DVBAB82",49,0) SDPP ; Report # 7 - Full (Patient Profile MAS) Report "RTN","DVBAB82",50,0) ;Parameters "RTN","DVBAB82",51,0) ;============= "RTN","DVBAB82",52,0) ; DFN : Patient Identification Number "RTN","DVBAB82",53,0) ; SDR : R/Range or A/All "RTN","DVBAB82",54,0) ; SDBD : Begining date "RTN","DVBAB82",55,0) ; SDED : Ending date "RTN","DVBAB82",56,0) ; SDP : Print the profile? 1 OR 0 "RTN","DVBAB82",57,0) ; SDTYP(2) : Print appointments? 1 OR 0 "RTN","DVBAB82",58,0) ; SDTYP(1) : Print add/edits? 1 or 0 "RTN","DVBAB82",59,0) ; SDTYP(4) : Print enrollments? 1 or 0 "RTN","DVBAB82",60,0) ; SDTYP(3) : Print dispositions? 1 OR 0 "RTN","DVBAB82",61,0) ; SDTYP(7) : Print team information? 1 OR 0 "RTN","DVBAB82",62,0) ; SDTYP(5) : Print means test? 1 OR 0 "RTN","DVBAB82",63,0) ; "RTN","DVBAB82",64,0) N SDTYP,SDBD,SDED,SDACT,SDPRINT,SDYES,SDRANGE,SDBEG,SDEN "RTN","DVBAB82",65,0) S ^XTMP("JAP",$J,$$NOW^XLFDT(),"SDPP")=PARM "RTN","DVBAB82",66,0) S DFN=$P(PARM,"^",1),SDR=$P(PARM,"^",2),SDBD=$P(PARM,"^",3),SDED=$P(PARM,"^",4) "RTN","DVBAB82",67,0) S SDP=$P(PARM,"^",5),SDTYP(2)=$P(PARM,"^",6),SDTYP(1)=$P(PARM,"^",7) "RTN","DVBAB82",68,0) S SDTYP(4)=$P(PARM,"^",8),SDTYP(3)=$P(PARM,"^",9),SDTYP(7)=$P(PARM,"^",10),SDTYP(5)=$P(PARM,"^",11) "RTN","DVBAB82",69,0) D VAL Q:DVBERR "RTN","DVBAB82",70,0) S SDACT="",(SDYES,SDRANGE,SDPRINT)=0 "RTN","DVBAB82",71,0) I SDR="R" S SDRANGE=1 "RTN","DVBAB82",72,0) I SDP=1 S SDYES=1,SDPRINT=1 "RTN","DVBAB82",73,0) I 'SDRANGE S (SDBD,SDBEG)=2800101,(SDED,SDEND)=$$ENDDT(),SDHDR=1 "RTN","DVBAB82",74,0) D ENS^%ZISS "RTN","DVBAB82",75,0) S SDPRINT=1 "RTN","DVBAB82",76,0) S:(SDTYP(2)=1) SDTYP(2)="" ;appointments "RTN","DVBAB82",77,0) K:(SDTYP(2)=0) SDTYP(2) "RTN","DVBAB82",78,0) S:(SDTYP(1)=1) SDTYP(1)="" ;add/edits "RTN","DVBAB82",79,0) K:(SDTYP(1)=0) SDTYP(1) "RTN","DVBAB82",80,0) I (SDTYP(4)=1) S SDTYP(4)="",SDACT=0 ;enrollments "RTN","DVBAB82",81,0) K:(SDTYP(4)=0) SDTYP(4) "RTN","DVBAB82",82,0) S:(SDTYP(3)=1) SDTYP(3)="" ;dispositions "RTN","DVBAB82",83,0) K:(SDTYP(3)=0) SDTYP(3) "RTN","DVBAB82",84,0) S:(SDTYP(5)=1) SDTYP(5)="" ;means test "RTN","DVBAB82",85,0) K:(SDTYP(5)=0) SDTYP(5) "RTN","DVBAB82",86,0) I SDTYP(7)=1 D ;team information "RTN","DVBAB82",87,0) . S SDTYP(7)="",GBL="^TMP(""SDPP"","_$J_")" "RTN","DVBAB82",88,0) K:(SDTYP(7)=0) SDTYP(7) "RTN","DVBAB82",89,0) D PRINT^SDPPRT "RTN","DVBAB82",90,0) S VALMBCK="R" "RTN","DVBAB82",91,0) Q "RTN","DVBAB82",92,0) ENDDT() ;Calculate end date for "all" date "RTN","DVBAB82",93,0) N DVBAPPTS,DVBX "RTN","DVBAB82",94,0) S DVBAPPTS(1)=2800101,DVBAPPTS(4)=DFN,DVBAPPTS("SORT")="P" "RTN","DVBAB82",95,0) S DVBAPPTS("FLDS")=1,DVBAPPTS("MAX")=-1 "RTN","DVBAB82",96,0) S DVBX=$S(($$SDAPI^SDAMA301(.DVBAPPTS)>0):$O(^TMP($J,"SDAMA301",DFN,0)),1:DT_.24) "RTN","DVBAB82",97,0) K ^TMP($J,"SDAMA301") "RTN","DVBAB82",98,0) Q DVBX "RTN","DVBAB82",99,0) ; "RTN","DVBAB82",100,0) VIEW ; Report # 9 - View Registration Data Report "RTN","DVBAB82",101,0) ; Parameters "RTN","DVBAB82",102,0) ; ========== "RTN","DVBAB82",103,0) ; DFN : Patient Identification Number "RTN","DVBAB82",104,0) ; "RTN","DVBAB82",105,0) U IO "RTN","DVBAB82",106,0) S DFN=$P(PARM,"^",1) "RTN","DVBAB82",107,0) D VAL Q:DVBERR "RTN","DVBAB82",108,0) D EN1^DGRP "RTN","DVBAB82",109,0) Q "RTN","DVBAB82",110,0) ; "RTN","DVBAB82",111,0) DSRP ; Report # 6 - Reprint a Notice of Discharge Report "RTN","DVBAB82",112,0) ; Parameters "RTN","DVBAB82",113,0) ; % : 1=Report on all veterans for a given day (BDATE required) "RTN","DVBAB82",114,0) ; : 0=Report on a single Veteran (DFN required) "RTN","DVBAB82",115,0) ; BDATE : Original Processing Date - $H/FileMan "RTN","DVBAB82",116,0) ; DFN : Patient Identification Number "RTN","DVBAB82",117,0) ; "RTN","DVBAB82",118,0) N %,BDATE,DFN,DFNIEN "RTN","DVBAB82",119,0) S %=$P(PARM,"^",1),BDATE=$P(PARM,"^",2),DFN=$P(PARM,"^",3),DFNIEN="" "RTN","DVBAB82",120,0) I BDATE="" S DVBERR=1,^TMP("DVBA",$J,1)="0^Incorrect Date" Q "RTN","DVBAB82",121,0) D DUZ2^DVBAUTIL "RTN","DVBAB82",122,0) U IO "RTN","DVBAB82",123,0) D VAL Q:DVBERR "RTN","DVBAB82",124,0) I %=1 D Q "RTN","DVBAB82",125,0) . S HD="SINGLE NOTICE OF DISCHARGE REPRINTING" "RTN","DVBAB82",126,0) . D NOPARM^DVBAUTL2 "RTN","DVBAB82",127,0) . I $D(DVBAQUIT) D KILL^DVBAUTIL Q ;CAUTION: Short-circuit "RTN","DVBAB82",128,0) . S DTAR=^DVB(396.1,1,0),FDT(0)=$$FMTE^XLFDT(DT,"5DZ") "RTN","DVBAB82",129,0) . S HEAD="NOTICE OF DISCHARGE",HEAD1="FOR "_$P(DTAR,U,1)_" ON "_FDT(0) "RTN","DVBAB82",130,0) . I $D(^DVB(396.2,"B",DFN)) D "RTN","DVBAB82",131,0) . . S DFNIEN=$O(^DVB(396.2,"B",DFN,DFNIEN)),ADM=$P(^DVB(396.2,DFNIEN,0),U,3) "RTN","DVBAB82",132,0) . . I $D(^DGPM(+ADM,0)),$P(^(0),U,17)]"" S DCHPTR=$P(^DGPM(+ADM,0),U,17),DISCH=$S($P(^DGPM(DCHPTR,0),U,1)]"":$P(^(0),U,1),1:"") W ?($X+5),"Discharge date: ",$$FMTE^XLFDT(DISCH,"5DZ") "RTN","DVBAB82",133,0) . . I $P(^DVB(396.2,DFNIEN,0),U,7)'=DVBAD2 W *7,!!,"This does not belong to your RO.",!! H 3 Q "RTN","DVBAB82",134,0) . . I DFNIEN>0 S XDA=DFNIEN,DA=$P(^DVB(396.2,DFNIEN,0),U,1),ADMDT=$P(^DVB(396.2,DFNIEN,0),U,2),MB=$P(^(0),U,3) "RTN","DVBAB82",135,0) . . D REPRINT^DVBADSNT "RTN","DVBAB82",136,0) D DEQUE^DVBADSRP "RTN","DVBAB82",137,0) Q "RTN","DVBAB82",138,0) ; "RTN","DVBAB82",139,0) SPRPT ; Report # 8 - OP(Operation Report) "RTN","DVBAB82",140,0) ;Parameters "RTN","DVBAB82",141,0) ;============= "RTN","DVBAB82",142,0) ; DFN : Patient Identification Number "RTN","DVBAB82",143,0) ; SRTN : Select Operation "RTN","DVBAB82",144,0) ; "RTN","DVBAB82",145,0) N DFN,SRTN,MAGTMPR2,SRSITE "RTN","DVBAB82",146,0) I $O(^SRO(133,1))'="B" S SRSITE=1 "RTN","DVBAB82",147,0) S DFN=$P(PARM,"^",1),SRTN=$P(PARM,"^",2),MAGTMPR2=1 "RTN","DVBAB82",148,0) D VAL Q:DVBERR "RTN","DVBAB82",149,0) D ^SROPRPT "RTN","DVBAB82",150,0) Q "RTN","DVBAB82",151,0) ; "RTN","DVBAB82",152,0) CRPON ; Report # - 4 Reprint C&P Final Report "RTN","DVBAB82",153,0) ;Parameters "RTN","DVBAB82",154,0) ;============= "RTN","DVBAB82",155,0) ; RTYPE : Select Reprint Option (D)ate or (V)eteran "RTN","DVBAB82",156,0) ; RUNDATE : ORIGINAL PROCESSING date "RTN","DVBAB82",157,0) ; ANS : Reprinted by the RO or MAS "RTN","DVBAB82",158,0) ; % : LAB 1 OR 0 "RTN","DVBAB82",159,0) ; DA(1) : Patient IEN for lab results "RTN","DVBAB82",160,0) ; DFN : Patient Identification Number "RTN","DVBAB82",161,0) ; "RTN","DVBAB82",162,0) U IO "RTN","DVBAB82",163,0) N ONE "RTN","DVBAB82",164,0) S RTYPE=$P(PARM,"^",1),RUNDATE=$P(PARM,"^",2),ANS=$P(PARM,"^",3),%=$P(PARM,"^",4),DA(1)=$P(PARM,"^",5),DFN=$P(PARM,"^",6),DA=DA(1) "RTN","DVBAB82",165,0) I RTYPE="V" D VAL Q:DVBERR "RTN","DVBAB82",166,0) S XDD=^DD("DD"),$P(ULINE,"_",70)="_",ONE="N",Y=DT "RTN","DVBAB82",167,0) X XDD S HD="Reprint C & P Exams",SUPER=0 "RTN","DVBAB82",168,0) I $D(^XUSEC("DVBA C SUPERVISOR",DUZ)) S SUPER=1 "RTN","DVBAB82",169,0) S DVBCDT(0)=Y,PGHD="Compensation and Pension Exam Report",LOC=DUZ(2),PG=0,DVBCSITE=$S($D(^DVB(396.1,1,0)):$P(^(0),U,1),1:"Not specified") "RTN","DVBAB82",170,0) I "^D^V^"'[RTYPE S DVBERR=1,^TMP("DVBA",$J,1)="0^Incorrect Data Type" Q "RTN","DVBAB82",171,0) I ANS="R" K AUTO "RTN","DVBAB82",172,0) I ANS="M" S AUTO=1 "RTN","DVBAB82",173,0) I "^M^R^"'[ANS S DVBERR=1,^TMP("DVBA",$J,1)="0^Incorrect Data Type" Q "RTN","DVBAB82",174,0) I RTYPE="D" D GO^DVBCRPRT Q "RTN","DVBAB82",175,0) I RTYPE="V" D "RTN","DVBAB82",176,0) . S ONE="Y",RO=$P(^DVB(396.3,DA,0),U,3) "RTN","DVBAB82",177,0) . I RO'=DUZ(2)&('$D(AUTO))&(SUPER=0) W !!,*7,"Those results do not belong to your office.",!! Q "RTN","DVBAB82",178,0) . I RO=DUZ(2)&('$D(AUTO))&("RC"'[($P(^DVB(396.3,DA,0),U,18))) W *7,!!,"This request has not been released to the Regional Office yet.",!! Q "RTN","DVBAB82",179,0) . S PRTDATE=$P(^DVB(396.3,DA,0),U,16) I PRTDATE="" W *7,!!,"This has never been printed.",!! I SUPER=0 S OUT=1 Q "RTN","DVBAB82",180,0) . I %=1 D REN2^DVBCLABR Q "RTN","DVBAB82",181,0) . ;D OV^DVBCRPON "RTN","DVBAB82",182,0) . K DVBAON2 D SETLAB^DVBCPRNT,VARS^DVBCUTIL,STEP2^DVBCRPRT "RTN","DVBAB82",183,0) Q "RTN","DVBAB82",184,0) ; "RTN","DVBAB82",185,0) CIRPT ; Report # 5 - Insufficient Exam Report "RTN","DVBAB82",186,0) ;Parameters "RTN","DVBAB82",187,0) ;============= "RTN","DVBAB82",188,0) ; RPTTYPE : D/Detailed or S/Summary "RTN","DVBAB82",189,0) ; BEGDT : Beginning date $H/FileMan "RTN","DVBAB82",190,0) ; ENDDT : Ending date $H/FileMan "RTN","DVBAB82",191,0) ; RESANS : Insufficient Reason "RTN","DVBAB82",192,0) ; DVBAPRTY : Priority of Exam Code "RTN","DVBAB82",193,0) ; AO : Agent Orange "RTN","DVBAB82",194,0) ; BDD : Benefits Delivery at Discharge / Quick Start "RTN","DVBAB82",195,0) ; DES : DES Claimed Condition by Service Member / Fit for Duty "RTN","DVBAB82",196,0) ; ALL : All Others (Original Report w/ all codes except the above) "RTN","DVBAB82",197,0) ; "RTN","DVBAB82",198,0) N DVBAPRTY,RPTTYPE,BEGDT,ENDDT,RESANS "RTN","DVBAB82",199,0) U IO "RTN","DVBAB82",200,0) S RPTTYPE=$P(PARM,"^",1),BEGDT=$P(PARM,"^",2),ENDDT=$P(PARM,"^",3),RESANS=$P(PARM,"^",4) "RTN","DVBAB82",201,0) S DVBAPRTY=$P(PARM,"^",5) "RTN","DVBAB82",202,0) S ENDDT=ENDDT_".2359" "RTN","DVBAB82",203,0) I RPTTYPE="S" D SUM^DVBCIRPT Q "RTN","DVBAB82",204,0) I RPTTYPE="D" D "RTN","DVBAB82",205,0) . D INREAS "RTN","DVBAB82",206,0) . Q:($D(^TMP("DVBA",$J,1))) ;invalid reason sent "RTN","DVBAB82",207,0) . D EXMTPE,DETAIL^DVBCIRP1 "RTN","DVBAB82",208,0) Q "RTN","DVBAB82",209,0) ; "RTN","DVBAB82",210,0) EXMTPE ;exam types (retrieve all for filter) "RTN","DVBAB82",211,0) N DVBAXIFN "RTN","DVBAB82",212,0) F DVBAXIFN=0:0 S DVBAXIFN=$O(^DVB(396.6,DVBAXIFN)) Q:+DVBAXIFN=0 DO "RTN","DVBAB82",213,0) . S ^TMP($J,"XMTYPE",DVBAXIFN)="" "RTN","DVBAB82",214,0) Q "RTN","DVBAB82",215,0) INREAS ;insufficient reason (validate specific or retrieve all) "RTN","DVBAB82",216,0) N DVBAXIFN "RTN","DVBAB82",217,0) D:(RESANS="") ;use all insufficient reasons "RTN","DVBAB82",218,0) .F DVBAXIFN=0:0 S DVBAXIFN=$O(^DVB(396.94,DVBAXIFN)) Q:+DVBAXIFN=0 DO "RTN","DVBAB82",219,0) .. S DVBAARY("REASON",DVBAXIFN)="" "RTN","DVBAB82",220,0) D:(RESANS'="") ;use specific insufficient reason "RTN","DVBAB82",221,0) .I ('$D(^DVB(396.94,+RESANS))) D ;validate IEN "RTN","DVBAB82",222,0) ..S DVBERR=1,^TMP("DVBA",$J,1)="0^Invalid Insufficient Reason IEN" "RTN","DVBAB82",223,0) .E S DVBAARY("REASON",+RESANS)="" "RTN","DVBAB82",224,0) Q "RTN","DVBAB82",225,0) ; "RTN","DVBAB82",226,0) CRMS ; Report # 1 - Regional Office 21- day Certificate Printing Report. "RTN","DVBAB82",227,0) ; No Parameters "RTN","DVBAB82",228,0) ; "RTN","DVBAB82",229,0) U IO "RTN","DVBAB82",230,0) D ^DVBACRMS "RTN","DVBAB82",231,0) Q "RTN","DVBAB82",232,0) ; "RTN","DVBAB82",233,0) CRRR ; Report # 2 - Reprint a 21 - day Certificate for the RO "RTN","DVBAB82",234,0) ;Parameters "RTN","DVBAB82",235,0) ;============= "RTN","DVBAB82",236,0) ; DVBSEL : Select one of the following: "RTN","DVBAB82",237,0) ; N Patient Name "RTN","DVBAB82",238,0) ; D ORIGINAL PROCESSING DATE "RTN","DVBAB82",239,0) ; SDATE : ORIGINAL PROCESSING date - $H/FileMan "RTN","DVBAB82",240,0) ; XDA : Patient IEN "RTN","DVBAB82",241,0) ; "RTN","DVBAB82",242,0) U IO "RTN","DVBAB82",243,0) S DVBSEL=$P(PARM,"^",1),SDATE=$P(PARM,"^",2),XDA=$P(PARM,"^",3) "RTN","DVBAB82",244,0) I "^D^N^"'[DVBSEL S DVBERR=1,^TMP("DVBA",$J,1)="0^Incorrect Data Type" Q "RTN","DVBAB82",245,0) I DVBSEL="D" D I DVBERR Q "RTN","DVBAB82",246,0) . I SDATE="" S DVBERR=1,^TMP("DVBA",$J,1)="0^Undefined Date" Q "RTN","DVBAB82",247,0) . S %DT="X" S X=SDATE D ^%DT I Y<0 D Q "RTN","DVBAB82",248,0) . . S DVBERR=1,^TMP("DVBA",$J,1)="0^Incorrect Date Format" "RTN","DVBAB82",249,0) I DVBSEL="N" D I DVBERR Q "RTN","DVBAB82",250,0) . I XDA="" S DVBERR=1,^TMP("DVBA",$J,1)="0^Undefined Patient IEN" Q "RTN","DVBAB82",251,0) . S DIC=2,DIC(0)="NZX",X=XDA D ^DIC I Y<0 D I DVBERR Q "RTN","DVBAB82",252,0) . . S DVBERR=1,^TMP("DVBA",$J,1)="0^Invalid Patient Name." "RTN","DVBAB82",253,0) . S DFN=XDA "RTN","DVBAB82",254,0) D INIT^DVBACRRR I 'CONT Q "RTN","DVBAB82",255,0) D HDR^DVBACRRR,DATA^DVBACRRR "RTN","DVBAB82",256,0) Q "RTN","DVBAB82",257,0) ; "RTN","DVBAB82",258,0) CPRNT ; Report # 3 - Print C&P Final Report (manual) Report "RTN","DVBAB82",259,0) ; No Parameters "RTN","DVBAB82",260,0) ; "RTN","DVBAB82",261,0) S XDD=^DD("DD"),$P(ULINE,"_",70)="_",Y=DT "RTN","DVBAB82",262,0) X XDD S DVBCDT(0)=Y,PGHD="Compensation and Pension Exam Report",DVBCSITE=$S($D(^DVB(396.1,1,0)):$P(^(0),U,1),1:"Not Specified") "RTN","DVBAB82",263,0) D GO^DVBCPRNT "RTN","DVBAB82",264,0) Q "RTN","DVBAB82",265,0) VAL ; VALIDATE PATIENT "RTN","DVBAB82",266,0) I $G(DFN)="" S DVBERR=1,^TMP("DVBA",$J,1)="0^Undefined Patient IEN" G END "RTN","DVBAB82",267,0) S DIC=2,DIC(0)="NZX",X=DFN D ^DIC "RTN","DVBAB82",268,0) I Y<0 S DVBERR=1,^TMP("DVBA",$J,1)="0^Invalid Patient Name." G END "RTN","DVBAB82",269,0) Q "RTN","DVBAB82",270,0) ; "RTN","DVBAB82",271,0) VALDATE(DVBADTE) ;Validate Date "RTN","DVBAB82",272,0) ;dates must be valid internal FileMan format "RTN","DVBAB82",273,0) N X,Y,%DT "RTN","DVBAB82",274,0) S %DT="X",X=DVBADTE D ^%DT "RTN","DVBAB82",275,0) S:(Y=-1) DVBERR=1,^TMP("DVBA",$J,1)="0^Invalid FileMan formatted date." "RTN","DVBAB82",276,0) Q "RTN","DVBAB82",277,0) ; "RTN","DVBAB82",278,0) CNHDEOC ; Report #10 - FBCNH Display Episode of Care "RTN","DVBAB82",279,0) ; Parameters "RTN","DVBAB82",280,0) ; ========== "RTN","DVBAB82",281,0) ; DFN : IEN in PATIENT (#2) file "RTN","DVBAB82",282,0) ; IFN : IEN in FEE CNH ACTIVITY (#162.3) file "RTN","DVBAB82",283,0) ; "RTN","DVBAB82",284,0) U IO "RTN","DVBAB82",285,0) N DFN,IFN "RTN","DVBAB82",286,0) S DFN=$P(PARM,U,1),IFN=$P(PARM,U,2) "RTN","DVBAB82",287,0) D ^FBNHDEC ;DBIA#: 5566 "RTN","DVBAB82",288,0) Q "RTN","DVBAB82",289,0) ; "RTN","DVBAB82",290,0) CNHRP ; Report #11 - FBCNH Roster Print "RTN","DVBAB82",291,0) ; Parameters "RTN","DVBAB82",292,0) ; ========== "RTN","DVBAB82",293,0) ; DVBADLMTD : 0 (Standard) or 1 (Delimited) "RTN","DVBAB82",294,0) ; "RTN","DVBAB82",295,0) U IO "RTN","DVBAB82",296,0) S DVBADLMTD=+$P($G(PARM),U) "RTN","DVBAB82",297,0) D START^FBNHROS ;DBIA#: 5566 "RTN","DVBAB82",298,0) Q "RTN","DVBAB82",299,0) ; "RTN","DVBAB82",300,0) CNHRAD ; Report #12 - FBCNH Report of Admissions/Discharges "RTN","DVBAB82",301,0) ; Parameters "RTN","DVBAB82",302,0) ; ========== "RTN","DVBAB82",303,0) ; BEGDATE : Start date in FM format "RTN","DVBAB82",304,0) ; ENDDATE : End date in FM format "RTN","DVBAB82",305,0) ; DVBADLMTD : 0 (Standard) or 1 (Delimited) "RTN","DVBAB82",306,0) ; "RTN","DVBAB82",307,0) U IO "RTN","DVBAB82",308,0) N BEGDATE,ENDDATE "RTN","DVBAB82",309,0) S BEGDATE=$P(PARM,U,1),ENDDATE=$P(PARM,U,2) "RTN","DVBAB82",310,0) S DVBADLMTD=+$P(PARM,U,3) "RTN","DVBAB82",311,0) D VALDATE(BEGDATE),VALDATE(ENDDATE) "RTN","DVBAB82",312,0) D:('+DVBERR) START^FBNHAMIE ;DBIA#: 5566 "RTN","DVBAB82",313,0) Q "RTN","DVBAB82",314,0) ; "RTN","DVBAB82",315,0) CNHSE90D ; Report #13 - FBCNH Stays in Excess of 90 Days "RTN","DVBAB82",316,0) ; Parameters "RTN","DVBAB82",317,0) ; ========== "RTN","DVBAB82",318,0) ; FBDT : Effective date in FM format "RTN","DVBAB82",319,0) ; DVBADLMTD : 0 (Standard) or 1 (Delimited) "RTN","DVBAB82",320,0) ; "RTN","DVBAB82",321,0) U IO "RTN","DVBAB82",322,0) N FBDT "RTN","DVBAB82",323,0) S FBDT=$P(PARM,U,1),DVBADLMTD=+$P(PARM,U,2) "RTN","DVBAB82",324,0) D VALDATE(FBDT) "RTN","DVBAB82",325,0) D:('+DVBERR) START^FBNHAMI2 ;DBIA#: 5566 "RTN","DVBAB82",326,0) Q "RTN","DVBAB82",327,0) ; "RTN","DVBAB82",328,0) HFS() ; -- get hfs file name "RTN","DVBAB82",329,0) N H "RTN","DVBAB82",330,0) S H=$H "RTN","DVBAB82",331,0) Q "DVBA_"_$J_"_"_$P(H,",")_"_"_$P(H,",",2)_".DAT" "RTN","DVBAB82",332,0) ; "RTN","DVBAB82",333,0) HFSOPEN(HANDLE,DVBHFS,DVBMODE) ; Open File "RTN","DVBAB82",334,0) S DVBDIRY=$$GET^XPAR("DIV","DVB HFS SCRATCH") "RTN","DVBAB82",335,0) ;I DVBDIRY="" S ECERR=1 D Q "RTN","DVBAB82",336,0) ;. S ^TMP("DVBA",$J,1)="0^A scratch directory for reports doesn't exist" "RTN","DVBAB82",337,0) D OPEN^%ZISH(HANDLE,,DVBHFS,$G(DVBMODE,"W")) D:POP Q:POP "RTN","DVBAB82",338,0) .S DVBERR=1,^TMP("DVBA",$J,1)="0^Unable to open file " "RTN","DVBAB82",339,0) S IOF="$$IOF^DVBAB82" ;resets screen position and adds page break flag - added to deal with Linux environments. "RTN","DVBAB82",340,0) Q "RTN","DVBAB82",341,0) ; "RTN","DVBAB82",342,0) HFSCLOSE(HANDLE,DVBHFS) ;Close HFS and unload data "RTN","DVBAB82",343,0) N DVBDEL,X,%ZIS "RTN","DVBAB82",344,0) D CLOSE^%ZISH(HANDLE) "RTN","DVBAB82",345,0) S ROOT=$NA(^TMP("DVBA",$J,1)),DVBDEL(DVBHFS)="" "RTN","DVBAB82",346,0) K:('+DVBERR) @ROOT "RTN","DVBAB82",347,0) S X=$$FTG^%ZISH(,DVBHFS,$NA(@ROOT@(1)),4) "RTN","DVBAB82",348,0) S X=$$DEL^%ZISH(,$NA(DVBDEL)) "RTN","DVBAB82",349,0) Q "RTN","DVBAB82",350,0) ; "RTN","DVBAB82",351,0) IOF() ;used to reset position and insert page break flag when @IOF is executed. "RTN","DVBAB82",352,0) S $X=0,$Y=0 "RTN","DVBAB82",353,0) Q "##FFFF##"_$C(13,10) "RTN","DVBAB82",354,0) ; "RTN","DVBAB82",355,0) REQSTAT ; Report #14 - Request Status by Date Range "RTN","DVBAB82",356,0) ; Parameters "RTN","DVBAB82",357,0) ; ========== "RTN","DVBAB82",358,0) ; BEGDAT : Start date in FM format "RTN","DVBAB82",359,0) ; ENDDAT : End date in FM format "RTN","DVBAB82",360,0) ; REQSTAT : Request Status filter "RTN","DVBAB82",361,0) ; ISDELIM : 0 (Standard format); 1 (Delimited format) "RTN","DVBAB82",362,0) ; ISNODT : 0 (Use date range); 1 (Ignore date range) "RTN","DVBAB82",363,0) U IO "RTN","DVBAB82",364,0) N BEGDAT,ENDDAT,REQSTAT "RTN","DVBAB82",365,0) S BEGDAT=$P(PARM,U,1),ENDDAT=$P(PARM,U,2) "RTN","DVBAB82",366,0) S REQSTAT=$P(PARM,U,3),ISDELIM=$P(PARM,U,4),ISNODT=$P(PARM,U,5) "RTN","DVBAB82",367,0) D VALDATE(BEGDAT),VALDATE(ENDDAT) "RTN","DVBAB82",368,0) D:('+DVBERR) REQSTAT^DVBARSBD(BEGDAT,ENDDAT,REQSTAT,ISDELIM,ISNODT) "RTN","DVBAB82",369,0) Q "RTN","DVBAB98") 0^8^B34547501^B29136155 "RTN","DVBAB98",1,0) DVBAB98 ;ALB/SPH - CAPRI CONVERSION OF DVBARAD1 FOR SUPPORT ; 3/22/12 8:33am "RTN","DVBAB98",2,0) ;;2.7;AMIE;**35,149,179**;Apr 10, 1995;Build 15 "RTN","DVBAB98",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","DVBAB98",4,0) ; "RTN","DVBAB98",5,0) S ZX="PENSION ",ZY="A & A " "RTN","DVBAB98",6,0) S MSG="" F ZZ=1:1:7 S MSG=MSG_ZX "RTN","DVBAB98",7,0) S MSG1="" F ZZ=1:1:7 S MSG1=MSG1_ZY "RTN","DVBAB98",8,0) U IO K DVBAQUIT "RTN","DVBAB98",9,0) F DVBAT="PEN","A&A" W:((IOST?1"C-".E)!(IOST'?1"P-OTHER".E)) @IOF W !!!!!!!!!! D PRINT Q:$D(DVBAQUIT) "RTN","DVBAB98",10,0) S ZMSG=$NA(^TMP("DVBAR",$J)) "RTN","DVBAB98",11,0) G KILL "RTN","DVBAB98",12,0) ; "RTN","DVBAB98",13,0) PRINTB S DATA1=$S($D(^TMP("DVBA",DVBAT,$J,SORTDT,XCN,XCFLOC,K,DA,"LADM")):^("LADM"),1:"") S (LADMDT,ADMDT)=$P(DATA1,U),LTDIS=$P(DATA1,U,2),DFN=DA,QUIT1=1 K DATA1 D ADM^DVBAVDPT K QUIT1,DVBAQ "RTN","DVBAB98",14,0) S LBEDSEC=BEDSEC,LDIAG=DIAG,LDCHGDT=DCHGDT,ADMDT=$P(DATA,U),RCVAA=$P(DATA,U,2),RCVPEN=$P(DATA,U,3),CNUM=$P(DATA,U,4),TDIS=$P(DATA,U,5) D ADM^DVBAVDPT "RTN","DVBAB98",15,0) S RCVPEN=$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified"),RCVAA=$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified") "RTN","DVBAB98",16,0) W @IOF,!!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!,?(80-$L(HEADDT)\2),HEADDT,!!! "RTN","DVBAB98",17,0) S:ADMDT]"" ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ") "RTN","DVBAB98",18,0) S:DCHGDT]"" DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ") "RTN","DVBAB98",19,0) S:LADMDT]"" LADMDT=$$FMTE^XLFDT(LADMDT,"5DZ") "RTN","DVBAB98",20,0) S:LDCHGDT]"" LDCHGDT=$$FMTE^XLFDT(LDCHGDT,"5DZ") "RTN","DVBAB98",21,0) ;create delimited/non-delimited report "RTN","DVBAB98",22,0) D:($G(DVBADLMTR)'="") PRINTD "RTN","DVBAB98",23,0) D:($G(DVBADLMTR)="") PRINTND "RTN","DVBAB98",24,0) Q "RTN","DVBAB98",25,0) ; "RTN","DVBAB98",26,0) PRINTND ;create non-delimited re-admission report "RTN","DVBAB98",27,0) S ^TMP("DVBAR",$J,DVBABCNT)="",DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",28,0) S ^TMP("DVBAR",$J,DVBABCNT)="Patient: "_PNAM_" SSN: "_SSN_" Claim Folder Loc: "_CFLOC,DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",29,0) S ^TMP("DVBAR",$J,DVBABCNT)="Claim #: "_CNUM_" Pension: "_RCVPEN_" A&A: "_RCVAA,DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",30,0) S ^TMP("DVBAR",$J,DVBABCNT)="================================================================================",DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",31,0) D ELIG "RTN","DVBAB98",32,0) S ^TMP("DVBAR",$J,DVBABCNT)="Current Admission Data:",DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",33,0) S ^TMP("DVBAR",$J,DVBABCNT)="-----------------------",DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",34,0) S ^TMP("DVBAR",$J,DVBABCNT)="Admission Date: "_ADMDT,DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",35,0) S ^TMP("DVBAR",$J,DVBABCNT)="Admitting Diagnosis: "_DIAG,DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",36,0) S ^TMP("DVBAR",$J,DVBABCNT)="Discharge Date: "_DCHGDT,DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",37,0) S ^TMP("DVBAR",$J,DVBABCNT)="Discharge Type: "_TDIS,DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",38,0) S ^TMP("DVBAR",$J,DVBABCNT)="Bed Service: "_BEDSEC,DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",39,0) S ^TMP("DVBAR",$J,DVBABCNT)="",DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",40,0) S ^TMP("DVBAR",$J,DVBABCNT)="Prior Admission Data:",DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",41,0) S ^TMP("DVBAR",$J,DVBABCNT)="---------------------",DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",42,0) S ^TMP("DVBAR",$J,DVBABCNT)="Admission Date: "_LADMDT,DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",43,0) S ^TMP("DVBAR",$J,DVBABCNT)="Admitting Diagnosis: "_LDIAG,DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",44,0) S ^TMP("DVBAR",$J,DVBABCNT)="Discharge Date: "_LDCHGDT,DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",45,0) S ^TMP("DVBAR",$J,DVBABCNT)="Discharge Type: "_LTDIS,DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",46,0) S ^TMP("DVBAR",$J,DVBABCNT)="Bed Service: "_LBEDSEC,DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",47,0) S ^TMP("DVBAR",$J,DVBABCNT)="",DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",48,0) ;I IOST?1"C-".E W *7,!,"Press RETURN to continue or ""^"" to stop " R ANS:DTIME S:ANS=U!('$T) XCN="ZZZZ" I '$T S DVBAQUIT=1 "RTN","DVBAB98",49,0) Q "RTN","DVBAB98",50,0) ; "RTN","DVBAB98",51,0) PRINTD ;create delimited re-admission report "RTN","DVBAB98",52,0) D:('$D(^XTMP("DVBA_READMISSION_RPT"_$J,0))) COLHDR "RTN","DVBAB98",53,0) S ^TMP("DVBAR",$J,DVBABCNT)=PNAM_DVBADLMTR_SSN_DVBADLMTR_CFLOC_DVBADLMTR_CNUM_DVBADLMTR_RCVPEN_DVBADLMTR_RCVAA_DVBADLMTR "RTN","DVBAB98",54,0) D ELIG "RTN","DVBAB98",55,0) S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_ADMDT_DVBADLMTR_DIAG_DVBADLMTR_DCHGDT_DVBADLMTR_TDIS_DVBADLMTR_BEDSEC_DVBADLMTR "RTN","DVBAB98",56,0) S ^TMP("DVBAR",$J,DVBABCNT)=^TMP("DVBAR",$J,DVBABCNT)_LADMDT_DVBADLMTR_LDIAG_DVBADLMTR_LDCHGDT_DVBADLMTR_LTDIS_DVBADLMTR_LBEDSEC "RTN","DVBAB98",57,0) S DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",58,0) Q "RTN","DVBAB98",59,0) ; "RTN","DVBAB98",60,0) PRINT S NODTA=1 S (SORTDT,XCN,XCFLOC,ANS)="" "RTN","DVBAB98",61,0) I $D(^TMP("DVBA",DVBAT,$J)) F XLINE=1:1:5 W ?5,$S(DVBAT="PEN":MSG,DVBAT="A&A":MSG1,1:""),!! "RTN","DVBAB98",62,0) F G=0:0 S SORTDT=$O(^TMP("DVBA",DVBAT,$J,SORTDT)) Q:SORTDT="" F DVBAM=0:0 S XCN=$O(^TMP("DVBA",DVBAT,$J,SORTDT,XCN)) Q:XCN="" D PRINT1 "RTN","DVBAB98",63,0) Q "RTN","DVBAB98",64,0) PRINT1 F J=0:0 S XCFLOC=$O(^TMP("DVBA",DVBAT,$J,SORTDT,XCN,XCFLOC)) Q:XCFLOC="" F K=0:0 S K=$O(^TMP("DVBA",DVBAT,$J,SORTDT,XCN,XCFLOC,K)) Q:K="" D PRINTC "RTN","DVBAB98",65,0) Q "RTN","DVBAB98",66,0) PRINTC F DA=0:0 S DA=$O(^TMP("DVBA",DVBAT,$J,SORTDT,XCN,XCFLOC,K,DA)) Q:DA="" S DATA=^(DA) D PRINTB "RTN","DVBAB98",67,0) Q "RTN","DVBAB98",68,0) ; "RTN","DVBAB98",69,0) KILL K ^TMP("DVBA","A&A",$J),^TMP("DVBA","PEN",$J) "RTN","DVBAB98",70,0) K:(DVBAFNLDTE=$P(EDATE,".")) ^XTMP("DVBA_READMISSION_RPT"_$J,0) "RTN","DVBAB98",71,0) D ^%ZISC S X=7 D:$D(ZTQUEUED) KILL^%ZTLOAD G FINAL^DVBAUTIL "RTN","DVBAB98",72,0) ; "RTN","DVBAB98",73,0) ELIG S ELIG=DVBAELIG,INCMP=0 "RTN","DVBAB98",74,0) W "Eligibility: " "RTN","DVBAB98",75,0) I ELIG]"" S ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")" "RTN","DVBAB98",76,0) I $D(^DPT(DA,.29)),$P(^(.29),U,1)]"" S INCMP=1 ;date ruled incomp, VA "RTN","DVBAB98",77,0) I $D(^DPT(DA,.29)),$P(^(.29),U,12)=1 S INCMP=1 ;ruled incomp field "RTN","DVBAB98",78,0) W ELIG_$S(ELIG]"":", ",1:"") W:$X>60 !?14 W $S(INCMP=1:"Incompetent",1:""),! "RTN","DVBAB98",79,0) Q "RTN","DVBAB98",80,0) ; "RTN","DVBAB98",81,0) COLHDR ;Column header for delimited report "RTN","DVBAB98",82,0) S ^TMP("DVBAR",$J,DVBABCNT)="Patient"_DVBADLMTR_"SSN"_DVBADLMTR_"Claim Folder Loc"_DVBADLMTR "RTN","DVBAB98",83,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Claim #"_DVBADLMTR_"Pension"_DVBADLMTR_"A&A"_DVBADLMTR "RTN","DVBAB98",84,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Current Admission Date"_DVBADLMTR_"Current Admitting Diagnosis"_DVBADLMTR "RTN","DVBAB98",85,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Current Discharge Date"_DVBADLMTR_"Current Discharge Type"_DVBADLMTR "RTN","DVBAB98",86,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Current Bed Service"_DVBADLMTR_"Prior Admission Date"_DVBADLMTR "RTN","DVBAB98",87,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Prior Admitting Diagnosis"_DVBADLMTR_"Prior Discharge Date"_DVBADLMTR "RTN","DVBAB98",88,0) S ^TMP("DVBAR",$J,DVBABCNT)=(^TMP("DVBAR",$J,DVBABCNT))_"Prior Discharge Type"_DVBADLMTR_"Prior Bed Service" "RTN","DVBAB98",89,0) S DVBABCNT=DVBABCNT+1 "RTN","DVBAB98",90,0) S ^XTMP("DVBA_READMISSION_RPT"_$J,0)=DT_U_DT "RTN","DVBAB98",91,0) Q "RTN","DVBARSBD") 0^2^B41501602^n/a "RTN","DVBARSBD",1,0) DVBARSBD ;ALB/RPM - CAPRI 2507 REQUEST STATUS BY DT RANGE REPORT ; 01/24/12 "RTN","DVBARSBD",2,0) ;;2.7;AMIE;**179**;Apr 10, 1995;Build 15 "RTN","DVBARSBD",3,0) ; "RTN","DVBARSBD",4,0) Q ;NO DIRECT ENTRY "RTN","DVBARSBD",5,0) ; "RTN","DVBARSBD",6,0) REQSTAT(DVBSDAT,DVBEDAT,DVBRSTAT,DVBDELIM,DVBNODT) ;entry for request status by dt range "RTN","DVBARSBD",7,0) ; "RTN","DVBARSBD",8,0) ; Input: "RTN","DVBARSBD",9,0) ; DVBSDAT - start date (FM format) "RTN","DVBARSBD",10,0) ; DVBEDAT - end date (FM format) "RTN","DVBARSBD",11,0) ; DVBRSTAT - request status (internal format) "RTN","DVBARSBD",12,0) ; DVBDELIM - return delimited results (0=no;1=yes) "RTN","DVBARSBD",13,0) ; DVBNODT - ignore date range (0=no;1=yes) "RTN","DVBARSBD",14,0) ; "RTN","DVBARSBD",15,0) N EXSTAT ;request status (external format) "RTN","DVBARSBD",16,0) N EXSDAT ;start date (external format: MM/DD/YYYY) "RTN","DVBARSBD",17,0) N EXEDAT ;end date (external format: MM/DD/YYYY) "RTN","DVBARSBD",18,0) N DVBARS ;request status conversion results "RTN","DVBARSBD",19,0) N DVBERR ;FM error msg "RTN","DVBARSBD",20,0) N DVBCNT ;returned record count "RTN","DVBARSBD",21,0) ; "RTN","DVBARSBD",22,0) K ^TMP("DVBREQ",$J) "RTN","DVBARSBD",23,0) K ^TMP("DVBREQN",$J) "RTN","DVBARSBD",24,0) S EXSDAT=$$FMTE^XLFDT(DVBSDAT,"5DZ") "RTN","DVBARSBD",25,0) S EXEDAT=$$FMTE^XLFDT(DVBEDAT,"5DZ") "RTN","DVBARSBD",26,0) I DVBRSTAT="A" S EXSTAT="ALL" "RTN","DVBARSBD",27,0) E D "RTN","DVBARSBD",28,0) . D CHK^DIE(396.3,17,"E",DVBRSTAT,.DVBARS,"DVBERR") "RTN","DVBARSBD",29,0) . S EXSTAT=$G(DVBARS(0)) "RTN","DVBARSBD",30,0) S DVBCNT=0 "RTN","DVBARSBD",31,0) ; "RTN","DVBARSBD",32,0) ;collect records matching search criteria "RTN","DVBARSBD",33,0) I DVBNODT D "RTN","DVBARSBD",34,0) . S EXSDAT="NO START DATE" "RTN","DVBARSBD",35,0) . S EXEDAT="NO END DATE" "RTN","DVBARSBD",36,0) . D GETRECSN(DVBRSTAT,.DVBCNT) "RTN","DVBARSBD",37,0) E D "RTN","DVBARSBD",38,0) . D GETRECS(DVBSDAT,DVBEDAT,DVBRSTAT,.DVBCNT) "RTN","DVBARSBD",39,0) ; "RTN","DVBARSBD",40,0) ;output results "RTN","DVBARSBD",41,0) I 'DVBCNT D "RTN","DVBARSBD",42,0) . W "NO DATA FOUND" "RTN","DVBARSBD",43,0) E D "RTN","DVBARSBD",44,0) . I DVBDELIM D DELIMHDR(EXSDAT,EXEDAT,EXSTAT),DELIM ;delimited format "RTN","DVBARSBD",45,0) . I 'DVBDELIM D PLAINHDR(EXSDAT,EXEDAT,EXSTAT),PLAIN ;plain text format "RTN","DVBARSBD",46,0) K ^TMP("DVBREQ",$J) "RTN","DVBARSBD",47,0) K ^TMP("DVBREQN",$J) "RTN","DVBARSBD",48,0) Q "RTN","DVBARSBD",49,0) ; "RTN","DVBARSBD",50,0) GETRECS(SDAT,EDAT,RSTAT,CNT) ;collect 2507 REQUEST record matches "RTN","DVBARSBD",51,0) ;This procedure collects all 2507 REQUEST records that have a "RTN","DVBARSBD",52,0) ;DATE STATUS LAST CHANGED within the start and end dates and have "RTN","DVBARSBD",53,0) ;a REQUEST STATUS that matches the input request status parameter. "RTN","DVBARSBD",54,0) ; "RTN","DVBARSBD",55,0) ; Input: "RTN","DVBARSBD",56,0) ; SDAT - start date (FM format) "RTN","DVBARSBD",57,0) ; EDAT - end date (FM format) "RTN","DVBARSBD",58,0) ; RSTAT - request status (internal format) "RTN","DVBARSBD",59,0) ; CNT - record count (passed by reference) "RTN","DVBARSBD",60,0) ; "RTN","DVBARSBD",61,0) N CHGDAT ;change date "RTN","DVBARSBD",62,0) N DVBIEN ;2507 REQUEST IEN "RTN","DVBARSBD",63,0) N DVBSTAT ;2507 REQUEST STATUS "RTN","DVBARSBD",64,0) N FLD ;field array in external format "RTN","DVBARSBD",65,0) ; "RTN","DVBARSBD",66,0) S CHGDAT=SDAT-1 "RTN","DVBARSBD",67,0) F S CHGDAT=$O(^DVB(396.3,"AH",CHGDAT)) Q:'CHGDAT!(CHGDAT>EDAT) D "RTN","DVBARSBD",68,0) . S DVBIEN=0 "RTN","DVBARSBD",69,0) . F S DVBIEN=$O(^DVB(396.3,"AH",CHGDAT,DVBIEN)) Q:'DVBIEN D "RTN","DVBARSBD",70,0) . . S DVBSTAT=$$GET1^DIQ(396.3,DVBIEN_",",17,"I","","") "RTN","DVBARSBD",71,0) . . I RSTAT="A"!(DVBSTAT=RSTAT) D "RTN","DVBARSBD",72,0) . . . K FLD "RTN","DVBARSBD",73,0) . . . I $$SETFLDS(DVBIEN,.FLD) D "RTN","DVBARSBD",74,0) . . . . S CNT=CNT+1 "RTN","DVBARSBD",75,0) . . . . S ^TMP("DVBREQ",$J,CNT)=FLD("SS")_U_FLD("NM")_U_FLD("REQDT")_U_FLD("RELDT")_U_FLD("PRTDT")_U_FLD("RS")_U_FLD("CANDT")_U_FLD("RO") "RTN","DVBARSBD",76,0) Q "RTN","DVBARSBD",77,0) ; "RTN","DVBARSBD",78,0) SETFLDS(DVBIEN,DVBFLDS) ;build field array in external format "RTN","DVBARSBD",79,0) ;This function formats the collected record data in external format "RTN","DVBARSBD",80,0) ;and returns the results TRUE and an array on success. Otherwise, "RTN","DVBARSBD",81,0) ;the function returns FALSE. "RTN","DVBARSBD",82,0) ; "RTN","DVBARSBD",83,0) ; Integration Reference #10061 - DEM^VADPT "RTN","DVBARSBD",84,0) ; "RTN","DVBARSBD",85,0) ; Input: "RTN","DVBARSBD",86,0) ; DVBIEN - 2507 REQUEST IEN "RTN","DVBARSBD",87,0) ; DVBFLDS - field array passed by reference "RTN","DVBARSBD",88,0) ; "RTN","DVBARSBD",89,0) ; Output: "RTN","DVBARSBD",90,0) ; DVBFLDS("NM") - patient name "RTN","DVBARSBD",91,0) ; DVBFLDS("SS") - social security number "RTN","DVBARSBD",92,0) ; DVBFLDS("RS") - request status "RTN","DVBARSBD",93,0) ; DVBFLDS("REQDT") - request date "RTN","DVBARSBD",94,0) ; DVBFLDS("RELDT") - release date "RTN","DVBARSBD",95,0) ; DVBFLDS("PRTDT") - print date "RTN","DVBARSBD",96,0) ; DVBFLDS("CANDT") - canceled date "RTN","DVBARSBD",97,0) ; DVBFLDS("RO") - regional office "RTN","DVBARSBD",98,0) ; DVBFLDS("IREQDT") - request date in internal FM format "RTN","DVBARSBD",99,0) ; Function Result - return 1 on success; otherwise returns 0 "RTN","DVBARSBD",100,0) ; "RTN","DVBARSBD",101,0) N DFN ;PATIENT file IEN used in VADPT call "RTN","DVBARSBD",102,0) N DVBDAT ;2507 REQUEST data field array "RTN","DVBARSBD",103,0) N DVBIENS ;FM IENS value "RTN","DVBARSBD",104,0) N DVBRSLT ;function result "RTN","DVBARSBD",105,0) N VADM ;VADPT return array "RTN","DVBARSBD",106,0) ; "RTN","DVBARSBD",107,0) S DVBRSLT=0 "RTN","DVBARSBD",108,0) S DVBIENS=+$G(DVBIEN)_"," "RTN","DVBARSBD",109,0) D GETS^DIQ(396.3,DVBIENS,".01;1;2;13;15;17;19","IE","DVBDAT","") "RTN","DVBARSBD",110,0) S DFN=$G(DVBDAT(396.3,DVBIENS,.01,"I")) "RTN","DVBARSBD",111,0) D DEM^VADPT "RTN","DVBARSBD",112,0) I $G(VADM(1))'="" D ;only return record when name is resolved "RTN","DVBARSBD",113,0) . S DVBFLDS("NM")=$G(VADM(1)) "RTN","DVBARSBD",114,0) . S DVBFLDS("SS")=+$G(VADM(2)) "RTN","DVBARSBD",115,0) . S DVBFLDS("RS")=$G(DVBDAT(396.3,DVBIENS,17,"E")) "RTN","DVBARSBD",116,0) . S DVBFLDS("REQDT")=$$FMTE^XLFDT($G(DVBDAT(396.3,DVBIENS,1,"I")),"5DZ") "RTN","DVBARSBD",117,0) . S DVBFLDS("RELDT")=$$FMTE^XLFDT($G(DVBDAT(396.3,DVBIENS,13,"I")),"5DZ") "RTN","DVBARSBD",118,0) . S DVBFLDS("PRTDT")=$$FMTE^XLFDT($G(DVBDAT(396.3,DVBIENS,15,"I")),"5DZ") "RTN","DVBARSBD",119,0) . S DVBFLDS("CANDT")=$$FMTE^XLFDT($G(DVBDAT(396.3,DVBIENS,19,"I")),"5DZ") "RTN","DVBARSBD",120,0) . S DVBFLDS("RO")=$G(DVBDAT(396.3,DVBIENS,2,"E")) "RTN","DVBARSBD",121,0) . S DVBFLDS("IREQDT")=$G(DVBDAT(396.3,DVBIENS,1,"I")) "RTN","DVBARSBD",122,0) . S DVBRSLT=1 "RTN","DVBARSBD",123,0) Q DVBRSLT "RTN","DVBARSBD",124,0) ; "RTN","DVBARSBD",125,0) DELIMHDR(EXSDAT,EXEDAT,EXSTAT) ;output delimited format header "RTN","DVBARSBD",126,0) ; "RTN","DVBARSBD",127,0) ; Input: "RTN","DVBARSBD",128,0) ; EXSDAT - start date (external format) "RTN","DVBARSBD",129,0) ; EXEDAT - end date (external format) "RTN","DVBARSBD",130,0) ; EXSTAT - request status (external format) "RTN","DVBARSBD",131,0) ; "RTN","DVBARSBD",132,0) W "Request Status by Date Range Report" "RTN","DVBARSBD",133,0) W !,"Date Range: "_EXSDAT_" - "_EXEDAT "RTN","DVBARSBD",134,0) W !,"Request Status: ",EXSTAT "RTN","DVBARSBD",135,0) W ! "RTN","DVBARSBD",136,0) W !,"SSN^PatientName^RequestDT^DTReleased^DTPrinted^RequestStatus^DtCanceled^Station" "RTN","DVBARSBD",137,0) Q "RTN","DVBARSBD",138,0) ; "RTN","DVBARSBD",139,0) DELIM ;output delimited format "RTN","DVBARSBD",140,0) ; "RTN","DVBARSBD",141,0) N DVBI "RTN","DVBARSBD",142,0) S DVBI=0 "RTN","DVBARSBD",143,0) F S DVBI=$O(^TMP("DVBREQ",$J,DVBI)) Q:'DVBI D "RTN","DVBARSBD",144,0) . W !,^TMP("DVBREQ",$J,DVBI) "RTN","DVBARSBD",145,0) Q "RTN","DVBARSBD",146,0) ; "RTN","DVBARSBD",147,0) PLAINHDR(EXSDAT,EXEDAT,EXSTAT) ;output plain text header "RTN","DVBARSBD",148,0) ;Populate the header information. "RTN","DVBARSBD",149,0) ;CAUTION: The CAPRI GUI pulls this information to populate the header "RTN","DVBARSBD",150,0) ;for each page when creating a printed report. Do not modify the "RTN","DVBARSBD",151,0) ;content or line count of the header information without validating "RTN","DVBARSBD",152,0) ;against the CAPRI GUI interface. "RTN","DVBARSBD",153,0) ; "RTN","DVBARSBD",154,0) ;CAPRI GUI to populate "RTN","DVBARSBD",155,0) ; Input: "RTN","DVBARSBD",156,0) ; EXSDAT - start date (external format) "RTN","DVBARSBD",157,0) ; EXEDAT - end date (external format) "RTN","DVBARSBD",158,0) ; EXSTAT - request status (external format) "RTN","DVBARSBD",159,0) ; "RTN","DVBARSBD",160,0) N DVBLINE ;header separator "RTN","DVBARSBD",161,0) ; "RTN","DVBARSBD",162,0) S $P(DVBLINE,"-",131)="" "RTN","DVBARSBD",163,0) W "Date Range: "_EXSDAT_" - "_EXEDAT "RTN","DVBARSBD",164,0) W !,"Request Status: ",EXSTAT "RTN","DVBARSBD",165,0) W ! "RTN","DVBARSBD",166,0) W !,"SSN",?11,"PATIENT NAME",?33,"REQUEST DT",?45,"DT RELEASED" "RTN","DVBARSBD",167,0) W ?57,"DT PRINTED",?69,"STATUS",?98,"DT CANCELED",?110,"STATION" "RTN","DVBARSBD",168,0) W !,DVBLINE "RTN","DVBARSBD",169,0) Q "RTN","DVBARSBD",170,0) ; "RTN","DVBARSBD",171,0) PLAIN ;output plain text format "RTN","DVBARSBD",172,0) ;Output formatted text format. The patient name and station name "RTN","DVBARSBD",173,0) ;are truncated at 20 characters to maintain 132 character report. "RTN","DVBARSBD",174,0) ; "RTN","DVBARSBD",175,0) N DVBI ;generic counter "RTN","DVBARSBD",176,0) N DVBREQ ;request record "RTN","DVBARSBD",177,0) ; "RTN","DVBARSBD",178,0) S DVBI=0 "RTN","DVBARSBD",179,0) F S DVBI=$O(^TMP("DVBREQ",$J,DVBI)) Q:'DVBI D "RTN","DVBARSBD",180,0) . S DVBREQ=^TMP("DVBREQ",$J,DVBI) "RTN","DVBARSBD",181,0) . W !,$P(DVBREQ,U,1),?11,$E($P(DVBREQ,U,2),1,20),?33,$P(DVBREQ,U,3) "RTN","DVBARSBD",182,0) . W ?45,$P(DVBREQ,U,4),?57,$P(DVBREQ,U,5),?69,$P(DVBREQ,U,6) "RTN","DVBARSBD",183,0) . W ?98,$P(DVBREQ,U,7),?110,$E($P(DVBREQ,U,8),1,20) "RTN","DVBARSBD",184,0) Q "RTN","DVBARSBD",185,0) ; "RTN","DVBARSBD",186,0) GETRECSN(RSTAT,CNT) ;collect 2507 REQUEST status matches and ignore date range "RTN","DVBARSBD",187,0) ;This procedure collects all 2507 REQUEST records that have a REQUEST STATUS "RTN","DVBARSBD",188,0) ;that matches the input request status parameter regardless of the LAST "RTN","DVBARSBD",189,0) ;STATUS CHANGE DATE range. The procedure uses the "AF" index which sorts "RTN","DVBARSBD",190,0) ;by REQUEST STATUS and REGIONAL OFFICE. "RTN","DVBARSBD",191,0) ; "RTN","DVBARSBD",192,0) ; Input: "RTN","DVBARSBD",193,0) ; RSTAT - request status (internal format) "RTN","DVBARSBD",194,0) ; CNT - record count (passed by reference) "RTN","DVBARSBD",195,0) ; "RTN","DVBARSBD",196,0) N CHGDAT ;change date "RTN","DVBARSBD",197,0) N SRTDAT ;sort date "RTN","DVBARSBD",198,0) N DVBIEN ;2507 REQUEST IEN "RTN","DVBARSBD",199,0) N FLD ;field array in external format "RTN","DVBARSBD",200,0) N DVBRO ;regional office "RTN","DVBARSBD",201,0) ; "RTN","DVBARSBD",202,0) ;create list sorted by LAST STATUS CHANGE DATE "RTN","DVBARSBD",203,0) S DVBRO=0 "RTN","DVBARSBD",204,0) F S DVBRO=$O(^DVB(396.3,"AF",RSTAT,DVBRO)) Q:'DVBRO D "RTN","DVBARSBD",205,0) . S DVBIEN=0 "RTN","DVBARSBD",206,0) . F S DVBIEN=$O(^DVB(396.3,"AF",RSTAT,DVBRO,DVBIEN)) Q:'DVBIEN D "RTN","DVBARSBD",207,0) . . K FLD "RTN","DVBARSBD",208,0) . . I $$SETFLDS(DVBIEN,.FLD) D "RTN","DVBARSBD",209,0) . . . ;use request date as sort for blank date "RTN","DVBARSBD",210,0) . . . S SRTDAT=+$G(FLD("IREQDT")) "RTN","DVBARSBD",211,0) . . . S ^TMP("DVBREQN",$J,SRTDAT,DVBIEN)=FLD("SS")_U_FLD("NM")_U_FLD("REQDT")_U_FLD("RELDT")_U_FLD("PRTDT")_U_FLD("RS")_U_FLD("CANDT")_U_FLD("RO") "RTN","DVBARSBD",212,0) ; "RTN","DVBARSBD",213,0) ;load output global with sorted list "RTN","DVBARSBD",214,0) S CHGDAT="" ;use "" because value could be zero ("0") "RTN","DVBARSBD",215,0) F S CHGDAT=$O(^TMP("DVBREQN",$J,CHGDAT)) Q:(CHGDAT="") D "RTN","DVBARSBD",216,0) . S DVBIEN=0 "RTN","DVBARSBD",217,0) . F S DVBIEN=$O(^TMP("DVBREQN",$J,CHGDAT,DVBIEN)) Q:'DVBIEN D "RTN","DVBARSBD",218,0) . . S CNT=CNT+1 "RTN","DVBARSBD",219,0) . . S ^TMP("DVBREQ",$J,CNT)=^TMP("DVBREQN",$J,CHGDAT,DVBIEN) "RTN","DVBARSBD",220,0) Q "VER") 8.0^22.0 "^DD",396.3,396.3,7,0) DATE STATUS LAST CHANGED^D^^7;1^S %DT="EX" D ^%DT S X=Y K:Y<1 X "^DD",396.3,396.3,7,1,0) ^.1 "^DD",396.3,396.3,7,1,1,0) 396.3^AH "^DD",396.3,396.3,7,1,1,1) S ^DVB(396.3,"AH",$E(X,1,30),DA)="" "^DD",396.3,396.3,7,1,1,2) K ^DVB(396.3,"AH",$E(X,1,30),DA) "^DD",396.3,396.3,7,1,1,"%D",0) ^^2^2^3120117^ "^DD",396.3,396.3,7,1,1,"%D",1,0) This index is used to pull reports based on the last date that the "^DD",396.3,396.3,7,1,1,"%D",2,0) REQUEST STATUS (#17) field changed. "^DD",396.3,396.3,7,1,1,"DT") 3120117 "^DD",396.3,396.3,7,3) Enter date of the last REQUEST STATUS change. "^DD",396.3,396.3,7,5,1,0) 396.3^17^2 "^DD",396.3,396.3,7,9) ^ "^DD",396.3,396.3,7,21,0) ^^2^2^3120123^ "^DD",396.3,396.3,7,21,1,0) This is the date of the last change to the REQUEST STATUS field (#17). "^DD",396.3,396.3,7,21,2,0) The field is populated by a trigger on the REQUEST STATUS field. "^DD",396.3,396.3,7,"DT") 3120117 "^DD",396.3,396.3,17,0) REQUEST STATUS^RS^N:NEW;P:PENDING, REPORTED;S:PENDING, SCHEDULED;R:RELEASED TO RO, NOT PRINTED;C:COMPLETED, PRINTED BY RO;X:CANCELLED BY MAS;RX:CANCELLED BY RO;T:TRANSCRIBED;NT:NEW, TRANSFERRED IN;CT:COMPLETED, TRANSFERRED OUT;^0;18^Q "^DD",396.3,396.3,17,1,0) ^.1 "^DD",396.3,396.3,17,1,1,0) 396.3^AF^MUMPS "^DD",396.3,396.3,17,1,1,1) S DVBCRO=$P(^DVB(396.3,DA,0),U,3) S:DVBCRO]"" ^DVB(396.3,"AF",$E(X,1,30),DVBCRO,DA)="" K DVBCRO "^DD",396.3,396.3,17,1,1,2) S DVBCRO=$P(^DVB(396.3,DA,0),U,3) K:DVBCRO]"" ^DVB(396.3,"AF",$E(X,1,30),DVBCRO,DA) K DVBCRO "^DD",396.3,396.3,17,1,1,"%D",0) ^^2^2^2940906^ "^DD",396.3,396.3,17,1,1,"%D",1,0) This cross reference is to collect all entries with the same Regional "^DD",396.3,396.3,17,1,1,"%D",2,0) Office number and request status. "^DD",396.3,396.3,17,1,1,"DT") 2940906 "^DD",396.3,396.3,17,1,2,0) ^^TRIGGER^396.3^7 "^DD",396.3,396.3,17,1,2,1) K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DVB(396.3,D0,7)):^(7),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X=DIV N %I,%H,% D NOW^%DTC S DIH=$G(^DVB(396.3,DIV(0),7)),DIV=X S $P(^(7),U,1)=DIV,DIH=396.3,DIG=7 D ^DICR "^DD",396.3,396.3,17,1,2,2) K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DVB(396.3,D0,7)):^(7),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X=DIV N %I,%H,% D NOW^%DTC S DIH=$G(^DVB(396.3,DIV(0),7)),DIV=X S $P(^(7),U,1)=DIV,DIH=396.3,DIG=7 D ^DICR "^DD",396.3,396.3,17,1,2,"%D",0) ^^3^3^3120117^ "^DD",396.3,396.3,17,1,2,"%D",1,0) This trigger populates the DATE STATUS LAST CHANGED (#7) field with the "^DD",396.3,396.3,17,1,2,"%D",2,0) value of TODAY whenever the REQUEST STATUS (#17) field is entered or "^DD",396.3,396.3,17,1,2,"%D",3,0) changed. "^DD",396.3,396.3,17,1,2,"CREATE VALUE") TODAY "^DD",396.3,396.3,17,1,2,"DELETE VALUE") TODAY "^DD",396.3,396.3,17,1,2,"DT") 3120117 "^DD",396.3,396.3,17,1,2,"FIELD") DATE STATUS LAST "^DD",396.3,396.3,17,3) The status of the entire request. "^DD",396.3,396.3,17,21,0) ^^1^1^2950126^^ "^DD",396.3,396.3,17,21,1,0) This field contains the request status of the 2507 exam request. "^DD",396.3,396.3,17,"DT") 3120117 "BLD",8305,6) ^158 **END** **END**