KIDS Distribution saved on Nov 18, 2020@11:20:25 DG*5.3*1025 v6, IB*2.0*685 v3 **KIDS**:DG*5.3*1025^IB*2.0*685^ **INSTALL NAME** DG*5.3*1025 "BLD",11069,0) DG*5.3*1025^REGISTRATION^0^3201118^y "BLD",11069,1,0) ^^8^8^3200924^^ "BLD",11069,1,1,0) DG*5.3*1025 (Registration) is bundled with IB*2.0*685 (Integrated "BLD",11069,1,2,0) Billing) in host file. "BLD",11069,1,3,0) "BLD",11069,1,4,0) This patch introduces report to identify Former Service Members whose "BLD",11069,1,5,0) Primary Eligibility changed from EXPANDED MH CARE NON-ENROLLEE to a new "BLD",11069,1,6,0) Primary Eligibility with a verified eligibility status. These patients are "BLD",11069,1,7,0) no longer treated under the Other Than Honorable (OTH) authority (VHA "BLD",11069,1,8,0) Directive 1601A.02). "BLD",11069,4,0) ^9.64PA^33^1 "BLD",11069,4,33,0) 33 "BLD",11069,4,33,2,0) ^9.641^33.02^1 "BLD",11069,4,33,2,33.02,0) ELIGIBILITY CHANGES (sub-file) "BLD",11069,4,33,2,33.02,1,0) ^9.6411^.01^1 "BLD",11069,4,33,2,33.02,1,.01,0) ELIGIBILITY CHANGE DATE/TIME "BLD",11069,4,33,222) y^n^p^^^^n^^n "BLD",11069,4,33,224) "BLD",11069,4,"APDD",33,33.02) "BLD",11069,4,"APDD",33,33.02,.01) "BLD",11069,4,"B",33,33) "BLD",11069,6) 6 "BLD",11069,6.3) 11 "BLD",11069,"ABPKG") n "BLD",11069,"INIT") EN^DG53P1025 "BLD",11069,"KRN",0) ^9.67PA^1.5^25 "BLD",11069,"KRN",.4,0) .4 "BLD",11069,"KRN",.4,"NM",0) ^9.68A^^ "BLD",11069,"KRN",.401,0) .401 "BLD",11069,"KRN",.402,0) .402 "BLD",11069,"KRN",.403,0) .403 "BLD",11069,"KRN",.5,0) .5 "BLD",11069,"KRN",.84,0) .84 "BLD",11069,"KRN",1.5,0) 1.5 "BLD",11069,"KRN",1.6,0) 1.6 "BLD",11069,"KRN",1.61,0) 1.61 "BLD",11069,"KRN",1.62,0) 1.62 "BLD",11069,"KRN",3.6,0) 3.6 "BLD",11069,"KRN",3.8,0) 3.8 "BLD",11069,"KRN",9.2,0) 9.2 "BLD",11069,"KRN",9.8,0) 9.8 "BLD",11069,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",11069,"KRN",9.8,"NM",1,0) DGOTHFSM^^0^B165402370 "BLD",11069,"KRN",9.8,"NM",2,0) DG53P1025^^0^B3719779 "BLD",11069,"KRN",9.8,"NM",3,0) DGOTHFS2^^0^B266640838 "BLD",11069,"KRN",9.8,"NM","B","DG53P1025",2) "BLD",11069,"KRN",9.8,"NM","B","DGOTHFS2",3) "BLD",11069,"KRN",9.8,"NM","B","DGOTHFSM",1) "BLD",11069,"KRN",19,0) 19 "BLD",11069,"KRN",19,"NM",0) ^9.68A^4^4 "BLD",11069,"KRN",19,"NM",1,0) DG OTH REPORTS MENU^^2 "BLD",11069,"KRN",19,"NM",2,0) DG OTH FSM ELIG. CHANGE REPORT^^0 "BLD",11069,"KRN",19,"NM",3,0) DG OTH FSM DETAIL REPORT^^0 "BLD",11069,"KRN",19,"NM",4,0) DGEN ENROLLMENT REPORTS^^2 "BLD",11069,"KRN",19,"NM","B","DG OTH FSM DETAIL REPORT",3) "BLD",11069,"KRN",19,"NM","B","DG OTH FSM ELIG. CHANGE REPORT",2) "BLD",11069,"KRN",19,"NM","B","DG OTH REPORTS MENU",1) "BLD",11069,"KRN",19,"NM","B","DGEN ENROLLMENT REPORTS",4) "BLD",11069,"KRN",19.1,0) 19.1 "BLD",11069,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",11069,"KRN",101,0) 101 "BLD",11069,"KRN",409.61,0) 409.61 "BLD",11069,"KRN",771,0) 771 "BLD",11069,"KRN",779.2,0) 779.2 "BLD",11069,"KRN",870,0) 870 "BLD",11069,"KRN",8989.51,0) 8989.51 "BLD",11069,"KRN",8989.52,0) 8989.52 "BLD",11069,"KRN",8993,0) 8993 "BLD",11069,"KRN",8994,0) 8994 "BLD",11069,"KRN","B",.4,.4) "BLD",11069,"KRN","B",.401,.401) "BLD",11069,"KRN","B",.402,.402) "BLD",11069,"KRN","B",.403,.403) "BLD",11069,"KRN","B",.5,.5) "BLD",11069,"KRN","B",.84,.84) "BLD",11069,"KRN","B",1.5,1.5) "BLD",11069,"KRN","B",1.6,1.6) "BLD",11069,"KRN","B",1.61,1.61) "BLD",11069,"KRN","B",1.62,1.62) "BLD",11069,"KRN","B",3.6,3.6) "BLD",11069,"KRN","B",3.8,3.8) "BLD",11069,"KRN","B",9.2,9.2) "BLD",11069,"KRN","B",9.8,9.8) "BLD",11069,"KRN","B",19,19) "BLD",11069,"KRN","B",19.1,19.1) "BLD",11069,"KRN","B",101,101) "BLD",11069,"KRN","B",409.61,409.61) "BLD",11069,"KRN","B",771,771) "BLD",11069,"KRN","B",779.2,779.2) "BLD",11069,"KRN","B",870,870) "BLD",11069,"KRN","B",8989.51,8989.51) "BLD",11069,"KRN","B",8989.52,8989.52) "BLD",11069,"KRN","B",8993,8993) "BLD",11069,"KRN","B",8994,8994) "BLD",11069,"QDEF") ^^^^NO^^^^YES^^NO "BLD",11069,"QUES",0) ^9.62^^ "BLD",11069,"REQB",0) ^9.611^1^1 "BLD",11069,"REQB",1,0) DG*5.3*1016^2 "BLD",11069,"REQB","B","DG*5.3*1016",1) "FIA",33) OTH ELIGIBILITY PATIENT "FIA",33,0) ^DGOTH(33, "FIA",33,0,0) 33P "FIA",33,0,1) y^n^p^^^^n^^n "FIA",33,0,10) "FIA",33,0,11) "FIA",33,0,"RLRO") "FIA",33,0,"VR") 5.3^DG "FIA",33,33) 1 "FIA",33,33,2) "FIA",33,33.02) 1 "FIA",33,33.02,.01) "INIT") EN^DG53P1025 "IX",33,33,"F",0) 33^F^Eligibility Code modification^R^^F^IR^W^33.02^^^^^LS "IX",33,33,"F",.1,0) ^^2^2^3200813^ "IX",33,33,"F",.1,1,0) This cross-reference will capture the date/time of the eligibility code "IX",33,33,"F",.1,2,0) changes for a patient. "IX",33,33,"F",1) S ^DGOTH(33,"F",X,DA(1),DA)="" "IX",33,33,"F",2) K ^DGOTH(33,"F",X,DA(1),DA) "IX",33,33,"F",2.5) K ^DGOTH(33,"F") "IX",33,33,"F",11.1,0) ^.114IA^1^1 "IX",33,33,"F",11.1,1,0) 1^F^33.02^.01^^1^F "IX",33,33,"F",11.1,1,3) "KRN",19,11225,-1) 2^4 "KRN",19,11225,0) DGEN ENROLLMENT REPORTS^Enrollment Reports^^M^1253^^^^^^^114 "KRN",19,11225,10,0) ^19.01IP^9^9 "KRN",19,11225,10,8,0) 14843^7^7 "KRN",19,11225,10,8,"^") DG OTH FSM ELIG. CHANGE REPORT "KRN",19,11225,10,9,0) 14846^8^8 "KRN",19,11225,10,9,"^") DG OTH FSM DETAIL REPORT "KRN",19,11225,"U") ENROLLMENT REPORTS "KRN",19,14772,-1) 2^1 "KRN",19,14772,0) DG OTH REPORTS MENU^Other Than Honorable Reports^^M^520824656^^^^^^^ "KRN",19,14772,10,0) ^19.01IP^10^10 "KRN",19,14772,10,9,0) 14843^^6 "KRN",19,14772,10,9,"^") DG OTH FSM ELIG. CHANGE REPORT "KRN",19,14772,10,10,0) 14846^^7 "KRN",19,14772,10,10,"^") DG OTH FSM DETAIL REPORT "KRN",19,14772,"U") OTHER THAN HONORABLE REPORTS "KRN",19,14843,-1) 0^2 "KRN",19,14843,0) DG OTH FSM ELIG. CHANGE REPORT^Former OTH Patient Eligibility Change Report^^R^^^^^^^^ "KRN",19,14843,1,0) ^19.06^5^5^3200713^^^ "KRN",19,14843,1,1,0) Assist users in reviewing past encounters of Former Service Member for "KRN",19,14843,1,2,0) potential back-billing charges. This report provides data for all Former "KRN",19,14843,1,3,0) OTH Service Member whose primary eligibility changed from EXPANDED MH "KRN",19,14843,1,4,0) CARE NON-ENROLLEE to their verified/determined (VBA) primary eligibility "KRN",19,14843,1,5,0) within a user specified date range. "KRN",19,14843,25) MAIN^DGOTHFSM "KRN",19,14843,"U") FORMER OTH PATIENT ELIGIBILITY "KRN",19,14846,-1) 0^3 "KRN",19,14846,0) DG OTH FSM DETAIL REPORT^Former OTH Patient Detail Report^^R^^^^^^^^ "KRN",19,14846,1,0) ^^3^3^3200805^ "KRN",19,14846,1,1,0) This option assist users in reviewing Former Service Members for "KRN",19,14846,1,2,0) potential back-billing charges so veteran customer will be billed "KRN",19,14846,1,3,0) appropriately. "KRN",19,14846,25) MAIN^DGOTHFS2 "KRN",19,14846,"U") FORMER OTH PATIENT DETAIL REPO "MBREQ") 0 "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",114,-1) 1^1 "PKG",114,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",114,22,0) ^9.49I^1^1 "PKG",114,22,1,0) 5.3^2930813^2930821 "PKG",114,22,1,"PAH",1,0) 1025^3201118^520824665 "PKG",114,22,1,"PAH",1,1,0) ^^8^8^3201118 "PKG",114,22,1,"PAH",1,1,1,0) DG*5.3*1025 (Registration) is bundled with IB*2.0*685 (Integrated "PKG",114,22,1,"PAH",1,1,2,0) Billing) in host file. "PKG",114,22,1,"PAH",1,1,3,0) "PKG",114,22,1,"PAH",1,1,4,0) This patch introduces report to identify Former Service Members whose "PKG",114,22,1,"PAH",1,1,5,0) Primary Eligibility changed from EXPANDED MH CARE NON-ENROLLEE to a new "PKG",114,22,1,"PAH",1,1,6,0) Primary Eligibility with a verified eligibility status. These patients are "PKG",114,22,1,"PAH",1,1,7,0) no longer treated under the Other Than Honorable (OTH) authority (VHA "PKG",114,22,1,"PAH",1,1,8,0) Directive 1601A.02). "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") YES "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") 3 "RTN","DG53P1025") 0^2^B3719779 "RTN","DG53P1025",1,0) DG53P1025 ;SLC/RM - Patch DG*5.3*1025 Post Install Utility Routine ; July 15,2020@11:27am "RTN","DG53P1025",2,0) ;;5.3;Registration;**1025**;Aug 13, 1993;Build 11 "RTN","DG53P1025",3,0) ; "RTN","DG53P1025",4,0) ; "RTN","DG53P1025",5,0) ;ICR# TYPE REFERENCE TO "RTN","DG53P1025",6,0) ;----- ---- --------------------- "RTN","DG53P1025",7,0) ;10141 Sup XPDUTL "RTN","DG53P1025",8,0) ;10013 Sup ENALL^DIK "RTN","DG53P1025",9,0) ; "RTN","DG53P1025",10,0) ; This POST install routine will re-index the ELIGIBILITY CHANGES #33.02 "RTN","DG53P1025",11,0) ; multiple field .01 in the OTH ELIGIBILITY PATIENT file (#33) "RTN","DG53P1025",12,0) Q "RTN","DG53P1025",13,0) ; "RTN","DG53P1025",14,0) EN ;Post install entry point "RTN","DG53P1025",15,0) ; "RTN","DG53P1025",16,0) I $D(^DGOTH(33,"F")) D Q ;don't re-index if "F" already exists "RTN","DG53P1025",17,0) . D BMES^XPDUTL(" The OTH ELIGIBILITY PATIENT file (#33) 'F' x-ref already exist.") "RTN","DG53P1025",18,0) . D BMES^XPDUTL(" No re-indexing necessary.") "RTN","DG53P1025",19,0) . D BMES^XPDUTL(" ") "RTN","DG53P1025",20,0) ; "RTN","DG53P1025",21,0) N DIK,DA,MES "RTN","DG53P1025",22,0) D BMES^XPDUTL(" Please be patient while I re-index ""F"" cross reference on OTH ELIGIBILITY") "RTN","DG53P1025",23,0) D BMES^XPDUTL(" PATIENT file (#33)") "RTN","DG53P1025",24,0) I +$P(^DGOTH(33,0),U,4)<1 D Q "RTN","DG53P1025",25,0) . S MES(1)=" " "RTN","DG53P1025",26,0) . S MES(2)=" ------------------" "RTN","DG53P1025",27,0) . S MES(3)=" " "RTN","DG53P1025",28,0) . S MES(4)=" No records found in the OTH ELIGIBILITY PATIENT file (#33)" "RTN","DG53P1025",29,0) . S MES(5)=" " "RTN","DG53P1025",30,0) . S MES(6)=" Nothing to re-index." "RTN","DG53P1025",31,0) . S MES(7)=" " "RTN","DG53P1025",32,0) . S MES(8)=" " "RTN","DG53P1025",33,0) . D MES^XPDUTL(.MES) "RTN","DG53P1025",34,0) ;Only want to reindex the "F" x-ref "RTN","DG53P1025",35,0) S DIK(1)=".01^F" "RTN","DG53P1025",36,0) ;global root for Eligibility Changes multiple "RTN","DG53P1025",37,0) S DIK="^DGOTH(33,DA(1),2," "RTN","DG53P1025",38,0) ;loop through OTH ELIGIBILITY PATIENT file and index entries "RTN","DG53P1025",39,0) F DA(1)=0:0 S DA(1)=$O(^DGOTH(33,DA(1))) Q:DA(1)'>0 D ENALL^DIK "RTN","DG53P1025",40,0) I $D(^DGOTH(33,"F")) D Q "RTN","DG53P1025",41,0) . D BMES^XPDUTL(" The OTH ELIGIBILITY PATIENT file (#33) 'F' cross reference indexing was completed successfully.") "RTN","DG53P1025",42,0) Q "RTN","DG53P1025",43,0) ; "RTN","DGOTHFS2") 0^3^B266640838 "RTN","DGOTHFS2",1,0) DGOTHFS2 ;SLC/RM - FORMER OTH PATIENT DETAIL REPORT 2 ; July 30,2020@09:44am "RTN","DGOTHFS2",2,0) ;;5.3;Registration;**1025**;Aug 13, 1993;Build 11 "RTN","DGOTHFS2",3,0) ; "RTN","DGOTHFS2",4,0) ; "RTN","DGOTHFS2",5,0) ;ICR# TYPE REFERENCE TO "RTN","DGOTHFS2",6,0) ;----- ---- --------------------- "RTN","DGOTHFS2",7,0) ;2966 Cont. Sub. Direct global read of FILE #391 (DG is the Custodial Package) "RTN","DGOTHFS2",8,0) ;2462 Cont. Sub $$GET1^DIQ(27.11 (DG is the Custodial Package) "RTN","DGOTHFS2",9,0) ;3812 Cont. Sub. $$FINDCUR^DGENA (DG is the Custodial Package) "RTN","DGOTHFS2",10,0) ;4408 Cont. Sub. DISP^DGIBDSP (DG is the Custodial Package) "RTN","DGOTHFS2",11,0) ;642 Cont. Sub. $$MTS^DGMTU (DG is the Custodial Package) "RTN","DGOTHFS2",12,0) ;3789 Cont. Sub. DIS^DGMTU (DG is the Custodial Package) "RTN","DGOTHFS2",13,0) ;402 Cont. Sub. DG has approval for direct global read of "ADFN" index of FILE #409.68 "RTN","DGOTHFS2",14,0) ;3546 Cont. Sub. DG has approval for direct global read of FILE #40.8 "RTN","DGOTHFS2",15,0) ;733 Cont. Sub. DG has approval for direct global read of FILE #31 "RTN","DGOTHFS2",16,0) ; "RTN","DGOTHFS2",17,0) ;No direct call "RTN","DGOTHFS2",18,0) Q "RTN","DGOTHFS2",19,0) ; "RTN","DGOTHFS2",20,0) ;Entry point for DG FORMER OTH PATIENTS DETAIL REPORT option "RTN","DGOTHFS2",21,0) MAIN ; Initial Interactive Processing "RTN","DGOTHFS2",22,0) N DGSORT ;array of report parameters "RTN","DGOTHFS2",23,0) N ZTDESC,ZTQUEUED,ZTREQ,ZTSAVE,ZTSTOP,DGPTNM,DGMTS,VAUTD,%ZIS "RTN","DGOTHFS2",24,0) N INACTIVE,DGDFN,DFN,VAEL,VADM,I3,DGPID,DGPAGE "RTN","DGOTHFS2",25,0) ;check for database "RTN","DGOTHFS2",26,0) I '+$O(^DGOTH(33,"B","")) W !!!,$$CJ^XLFSTR(">>> No OTH records have been found. <<<",80) D ASKCONT^DGOTHFSM(0) Q "RTN","DGOTHFS2",27,0) W @IOF "RTN","DGOTHFS2",28,0) S INACTIVE=0 "RTN","DGOTHFS2",29,0) W "FORMER OTH PATIENT DETAIL REPORT",!! "RTN","DGOTHFS2",30,0) W "This option assists billing user in reviewing Former Service Member's past" "RTN","DGOTHFS2",31,0) W !,"checked out encounter and prescription details to determine if potential" "RTN","DGOTHFS2",32,0) W !,"back-billing is necessary." "RTN","DGOTHFS2",33,0) W !!,"*** THIS REPORT REQUIRES 132 COLUMN OUTPUT TO PRINT CORRECTLY ***" "RTN","DGOTHFS2",34,0) W !!,"At the DEVICE: prompt please accept the default value of '0;132;'" "RTN","DGOTHFS2",35,0) W !,"This is to deliberately avoid undesired wrapping problems of the data.",!! "RTN","DGOTHFS2",36,0) ;prompt user to enter patient "RTN","DGOTHFS2",37,0) D PROMPTPT "RTN","DGOTHFS2",38,0) Q:'INACTIVE!(DGSORT'>0) "RTN","DGOTHFS2",39,0) ;Prompt user what type of data/report user wish to see "RTN","DGOTHFS2",40,0) ;user had two options: Eligibility or Encounters "RTN","DGOTHFS2",41,0) I '$$RPTTYPE Q "RTN","DGOTHFS2",42,0) W !! "RTN","DGOTHFS2",43,0) S %ZIS="" "RTN","DGOTHFS2",44,0) S %ZIS("B")="0;132;" "RTN","DGOTHFS2",45,0) S ZTSAVE("DGSORT(")="" "RTN","DGOTHFS2",46,0) S ZTSAVE("DGSORT")="" "RTN","DGOTHFS2",47,0) S ZTSAVE("DGDFN")="" "RTN","DGOTHFS2",48,0) S ZTSAVE("DGPTNM")="" "RTN","DGOTHFS2",49,0) S X="FORMER OTH PATIENT ELIGIBILITY CHANGE REPORT" "RTN","DGOTHFS2",50,0) D EN^XUTMDEVQ("START^DGOTHFS2",X,.ZTSAVE,.%ZIS) "RTN","DGOTHFS2",51,0) D HOME^%ZIS "RTN","DGOTHFS2",52,0) Q "RTN","DGOTHFS2",53,0) ; "RTN","DGOTHFS2",54,0) START ;starting point to generate report "RTN","DGOTHFS2",55,0) I $E(IOST)="C" D WAIT^DICD "RTN","DGOTHFS2",56,0) N HERE S HERE=$$SITE^VASITE ;extract the IEN and facility name where the report is run "RTN","DGOTHFS2",57,0) N TRM S TRM=($E(IOST)="C") "RTN","DGOTHFS2",58,0) S (DGQ,DGPAGE,I3)=0 "RTN","DGOTHFS2",59,0) S DGIEN33=DGSORT "RTN","DGOTHFS2",60,0) S DFN=DGDFN "RTN","DGOTHFS2",61,0) S VAUTD=1 ;All the divisions in the facility, since we are not prompting user to enter Division "RTN","DGOTHFS2",62,0) S DGPID=$$GET1^DIQ(2,DFN_",",.0905,"I") "RTN","DGOTHFS2",63,0) ;display the patient's current and verified eligibility "RTN","DGOTHFS2",64,0) D CURRENT(DGDFN,DGPTNM) "RTN","DGOTHFS2",65,0) W ! "RTN","DGOTHFS2",66,0) ;display patient's Means Test Status information "RTN","DGOTHFS2",67,0) D MTS(DGDFN) "RTN","DGOTHFS2",68,0) ;display patient's Rated Disabilities information "RTN","DGOTHFS2",69,0) D RTDDIS(DGDFN) "RTN","DGOTHFS2",70,0) Q:DGQ "RTN","DGOTHFS2",71,0) ;display patient's Insurance information "RTN","DGOTHFS2",72,0) D INS(DGDFN) "RTN","DGOTHFS2",73,0) Q:DGQ "RTN","DGOTHFS2",74,0) ;display patient's all Primary Eligibility history "RTN","DGOTHFS2",75,0) D HISTORY(DGIEN33) "RTN","DGOTHFS2",76,0) Q:DGQ "RTN","DGOTHFS2",77,0) ;if user wants to see patient Encounter and Rx information "RTN","DGOTHFS2",78,0) I DGSORT("RTYPE")="N" D "RTN","DGOTHFS2",79,0) . ;determine first the original date the former OTH service member become EXPANDED "RTN","DGOTHFS2",80,0) . ;MH CARE NON-ENROLLEE and loop through all the OTH Registration Date "RTN","DGOTHFS2",81,0) . S DGSORT("DGBEG")=$$OTHREGDT(DGIEN33) "RTN","DGOTHFS2",82,0) . ;the date when the PE eligibility status of patient became VERIFIED "RTN","DGOTHFS2",83,0) . S DGSORT("DGEND")=$$GET1^DIQ(2,DGDFN_",",.3612,"I") "RTN","DGOTHFS2",84,0) . ;display patient's checked out Encounters "RTN","DGOTHFS2",85,0) . D ENCTR(DGDFN,.DGSORT) "RTN","DGOTHFS2",86,0) . Q:DGQ "RTN","DGOTHFS2",87,0) . ;display patient's Released Prescriptions "RTN","DGOTHFS2",88,0) . D RX(DGDFN,.DGSORT) "RTN","DGOTHFS2",89,0) D KVAR^VADPT "RTN","DGOTHFS2",90,0) D EXIT^DGOTHFSM "RTN","DGOTHFS2",91,0) Q "RTN","DGOTHFS2",92,0) ; "RTN","DGOTHFS2",93,0) PROMPTPT ;prompt user to enter patient "RTN","DGOTHFS2",94,0) ;keep prompting for patient name until user enter patient with INACTIVE status "RTN","DGOTHFS2",95,0) F D Q:INACTIVE "RTN","DGOTHFS2",96,0) . ;Prompt user for OTH patient name "RTN","DGOTHFS2",97,0) . S DGPTNM=$$SELPAT(.DGSORT) "RTN","DGOTHFS2",98,0) . I DGSORT'>0 S INACTIVE=1 Q "RTN","DGOTHFS2",99,0) . I $$ACTIVE(.DGSORT) D Q "RTN","DGOTHFS2",100,0) . . W !!,"The patient you selected is still PENDING for VBA Adjudication." "RTN","DGOTHFS2",101,0) . . D RUNOPT "RTN","DGOTHFS2",102,0) . ;if INACTIVE STATUS, check if the eligibility status is VERIFIED "RTN","DGOTHFS2",103,0) . S DGDFN=$P(DGSORT(0),U) "RTN","DGOTHFS2",104,0) . I $$GET1^DIQ(2,DGDFN_",",.3611,"I")'="V" D Q "RTN","DGOTHFS2",105,0) . . W !!,"The primary eligibility status of the patient you selected is not VERIFIED." "RTN","DGOTHFS2",106,0) . . D RUNOPT "RTN","DGOTHFS2",107,0) . S INACTIVE=1 "RTN","DGOTHFS2",108,0) Q "RTN","DGOTHFS2",109,0) ; "RTN","DGOTHFS2",110,0) RUNOPT ;display message to run FORMER OTH PATIENT ELIGIBILITY CHANGE REPORT option "RTN","DGOTHFS2",111,0) W !,"Please run FORMER OTH PATIENT ELIGIBILITY CHANGE REPORT option" "RTN","DGOTHFS2",112,0) W !,"to identify Former OTH Service Member whose Primary Eligibility" "RTN","DGOTHFS2",113,0) W !,"changed from EXPANDED MH CARE NON-ENROLLEE to a new Primary" "RTN","DGOTHFS2",114,0) W !,"Eligibility with a VERIFIED eligibility status.",! "RTN","DGOTHFS2",115,0) Q "RTN","DGOTHFS2",116,0) ; "RTN","DGOTHFS2",117,0) ACTIVE(DGSORT) ;determine the current status of OTH patient "RTN","DGOTHFS2",118,0) ;return 0 for INACTIVE "RTN","DGOTHFS2",119,0) ;otherwise, 1 for ACTIVE "RTN","DGOTHFS2",120,0) N DGIEN33,DGOTHSTAT "RTN","DGOTHFS2",121,0) S DGIEN33=DGSORT "RTN","DGOTHFS2",122,0) S DGOTHSTAT=$$GET1^DIQ(33,DGIEN33_",",.02,"I") "RTN","DGOTHFS2",123,0) Q DGOTHSTAT "RTN","DGOTHFS2",124,0) ; "RTN","DGOTHFS2",125,0) SELPAT(DGSORT) ;prompt for veteran's name "RTN","DGOTHFS2",126,0) ;- input vars for ^DIC call "RTN","DGOTHFS2",127,0) N DIC,DTOUT,DUOUT,X,Y "RTN","DGOTHFS2",128,0) S DIC="^DGOTH(33,",DIC(0)="AEMQZV" "RTN","DGOTHFS2",129,0) S DIC("A")="Enter Patient Name: " "RTN","DGOTHFS2",130,0) S DIC("?PARAM",33,"INDEX")="B" "RTN","DGOTHFS2",131,0) S DIC("?N",33)=12 "RTN","DGOTHFS2",132,0) ;- lookup patient "RTN","DGOTHFS2",133,0) D ^DIC K DIC "RTN","DGOTHFS2",134,0) ;- result of lookup "RTN","DGOTHFS2",135,0) S DGSORT=Y "RTN","DGOTHFS2",136,0) ;- if success, setup return array using output vars from ^DIC call "RTN","DGOTHFS2",137,0) I (+DGSORT>0) D Q Y(0,0) ;patient name "RTN","DGOTHFS2",138,0) . S DGSORT=+Y ;patient ien "RTN","DGOTHFS2",139,0) . S DGSORT(0)=$G(Y(0)) ;zero node of patient in (#2) file "RTN","DGOTHFS2",140,0) Q -1 "RTN","DGOTHFS2",141,0) ; "RTN","DGOTHFS2",142,0) RPTTYPE() ;prompt for type of data user wish to see "RTN","DGOTHFS2",143,0) N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO "RTN","DGOTHFS2",144,0) S DGDIRA="Which type of report do you wish to see ('E'ligibility/E'N'counters)?: " "RTN","DGOTHFS2",145,0) S DGDIRB="" "RTN","DGOTHFS2",146,0) S DGDIRH="^D HELP^DGOTHFS2" "RTN","DGOTHFS2",147,0) S DGDIRO="SAO^E:Eligibility;N:Encounters" "RTN","DGOTHFS2",148,0) S DGASK=$$ANSWER^DGOTHFSM(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGOTHFS2",149,0) I DGASK="E"!(DGASK="N") S DGSORT("RTYPE")=DGASK,DGASK=1 "RTN","DGOTHFS2",150,0) E S DGASK=0 "RTN","DGOTHFS2",151,0) Q DGASK "RTN","DGOTHFS2",152,0) ; "RTN","DGOTHFS2",153,0) HELP ;provide extended DIR("?") help text. "RTN","DGOTHFS2",154,0) ; "RTN","DGOTHFS2",155,0) ; Input: DGSEL - prompt var for help text word selection "RTN","DGOTHFS2",156,0) ; Output: none "RTN","DGOTHFS2",157,0) ; "RTN","DGOTHFS2",158,0) I (X="?")!(X="??") D "RTN","DGOTHFS2",159,0) . W !,"Select ""E""ligibility if you wish to see the Primary Eligibility history" "RTN","DGOTHFS2",160,0) . W !," Means Test, and Health Insurance information of the selected" "RTN","DGOTHFS2",161,0) . W !," patient.",! "RTN","DGOTHFS2",162,0) . W !,"Select ""N""encounters if you wish to see the Primary Eligibility" "RTN","DGOTHFS2",163,0) . W !," history, Means Test, Health Insurance information, Patient's" "RTN","DGOTHFS2",164,0) . W !," Checked Out Encounters, and patient's Release Prescriptions" "RTN","DGOTHFS2",165,0) . W !," of the selected patient.",! "RTN","DGOTHFS2",166,0) Q "RTN","DGOTHFS2",167,0) ; "RTN","DGOTHFS2",168,0) CURRENT(DFN,PTNAME) ;display patient current and verified PE eligibility "RTN","DGOTHFS2",169,0) N I1,DGENR,DGENRIEN,DGENRPRI,DGENRGRP "RTN","DGOTHFS2",170,0) S (DGENRIEN,DGENRPRI,DGENRGRP)="" "RTN","DGOTHFS2",171,0) D 2^VADPT "RTN","DGOTHFS2",172,0) D PTHDR("FORMER OTH PATIENT DETAIL REPORT") "RTN","DGOTHFS2",173,0) D LINE(0) "RTN","DGOTHFS2",174,0) W !,"Current Eligibility Code : ",$P(VAEL(1),"^",2)," -- ",$S(VAEL(8)']"":"NOT VERIFIED",1:$P(VAEL(8),"^",2)) "RTN","DGOTHFS2",175,0) W " ",$$FMTE^XLFDT($$GET1^DIQ(2,DGDFN_",",.3612,"I"),"5Z") ;PE eligibility changed date "RTN","DGOTHFS2",176,0) W !,"Other Eligibility Code(s): " I $D(VAEL(1))>9 S I1=0 F I=0:0 S I=$O(VAEL(1,I)) Q:'I S I1=I1+1 W:I1>1 !?28 W $P(VAEL(1,I),"^",2) "RTN","DGOTHFS2",177,0) E W "NO ADDITIONAL ELIGIBILITIES IDENTIFIED" "RTN","DGOTHFS2",178,0) S DGENRIEN=$$FINDCUR^DGENA(DFN) "RTN","DGOTHFS2",179,0) I DGENRIEN'="" S DGENRPRI=$$GET1^DIQ(27.11,DGENRIEN_",",.07,"E"),DGENRGRP=$$GET1^DIQ(27.11,DGENRIEN_",",.12,"E") "RTN","DGOTHFS2",180,0) W !,"Enrollment Priority : ",$S(DGENRIEN="":"NOT ENROLLED",((DGENRPRI="")&(DGENRGRP="")):"NONE STATED",1:DGENRPRI_DGENRGRP) "RTN","DGOTHFS2",181,0) W ! D LINE(1) "RTN","DGOTHFS2",182,0) Q "RTN","DGOTHFS2",183,0) ; "RTN","DGOTHFS2",184,0) MTS(DFN) ;display patient's Means Test Status information "RTN","DGOTHFS2",185,0) S DGMTS=$$MTS^DGMTU(DFN) "RTN","DGOTHFS2",186,0) I DGMTS="" W !,"Means Test Status : NOT IN MEANS TEST FILE" "RTN","DGOTHFS2",187,0) E D DIS^DGMTU(DFN) "RTN","DGOTHFS2",188,0) Q "RTN","DGOTHFS2",189,0) ; "RTN","DGOTHFS2",190,0) RTDDIS(DFN) ;display patient's rated disabilities information "RTN","DGOTHFS2",191,0) N DGPTYPE,DGC,DGARR "RTN","DGOTHFS2",192,0) W !!,"Service Connected : ",$S('+VAEL(3):"NO",1:"YES") "RTN","DGOTHFS2",193,0) W:+VAEL(3) ?33,"SC Percent : ",$P(VAEL(3),"^",2)_"%" "RTN","DGOTHFS2",194,0) W !!,"Rated Disabilities: " I 'VAEL(4),$S('$D(^DG(391,+VAEL(6),0)):1,$P(^(0),"^",2):0,1:1) W "NOT A VETERAN" Q "RTN","DGOTHFS2",195,0) I '$$RDIS^DGRPDB(DFN,.DGARR) W "NONE STATED" Q "RTN","DGOTHFS2",196,0) F DGC=0:0 S DGC=$O(DGARR(DGC)) Q:'DGC D Q:DGQ "RTN","DGOTHFS2",197,0) . S I3=I3+1 "RTN","DGOTHFS2",198,0) . N DGP1,DGP2,DGP3,DGZERO "RTN","DGOTHFS2",199,0) . I $G(DGARR(DGC))']"" Q "RTN","DGOTHFS2",200,0) . S DGZERO=+DGARR(DGC) "RTN","DGOTHFS2",201,0) . I '$D(^DIC(31,DGZERO,0)) Q "RTN","DGOTHFS2",202,0) . S DGP1=$P(^DIC(31,DGZERO,0),U,3) "RTN","DGOTHFS2",203,0) . S DGP2=$P(^DIC(31,DGZERO,0),U) "RTN","DGOTHFS2",204,0) . S DGP3="("_$S($P(DGARR(DGC),U,3)=1:$P(DGARR(DGC),U,2)_"% SC",$P(DGARR(DGC),U,3)]"":$P(DGARR(DGC),U,2)_"% NSC",1:"Unspecified")_")" "RTN","DGOTHFS2",205,0) . I $Y>(IOSL-4) W ! D PAUSE(.DGQ) Q:DGQ D PTHDR,LINE(0) "RTN","DGOTHFS2",206,0) . W:I3>1 !?20 "RTN","DGOTHFS2",207,0) . W $G(DGP1)_" - ",$E(DGP2,1,30)," ",DGP3 "RTN","DGOTHFS2",208,0) W:'I3 "NONE STATED" "RTN","DGOTHFS2",209,0) Q "RTN","DGOTHFS2",210,0) ; "RTN","DGOTHFS2",211,0) INS(DFN) ;display patient's health insurance information "RTN","DGOTHFS2",212,0) N Z,I,I1 "RTN","DGOTHFS2",213,0) ;if patient had more than 6 rated disability, then display the insurance information in a separate page "RTN","DGOTHFS2",214,0) I I3>6 W !! D PAUSE(.DGQ) Q:DGQ D PTHDR,LINE(0) "RTN","DGOTHFS2",215,0) W !!,"Health Insurance : " "RTN","DGOTHFS2",216,0) S Z=$$INSUR^IBBAPI(DFN,DT) "RTN","DGOTHFS2",217,0) W $S(Z:"YES",1:"NO") "RTN","DGOTHFS2",218,0) D DISP^DGIBDSP "RTN","DGOTHFS2",219,0) K I,I1,Z "RTN","DGOTHFS2",220,0) I $G(DGMTS)="" W ! "RTN","DGOTHFS2",221,0) Q "RTN","DGOTHFS2",222,0) ; "RTN","DGOTHFS2",223,0) HISTORY(IEN33) ;extract all eligibility history "RTN","DGOTHFS2",224,0) N DGELHIST,DGOTHIST,DGRECNUM,DGLINE,DGOTHTYP "RTN","DGOTHFS2",225,0) ;display this piece of information to its own page so that the report will not look cluttered "RTN","DGOTHFS2",226,0) D PAUSE(.DGQ) Q:DGQ D PTHDR,LINE(0) W !! "RTN","DGOTHFS2",227,0) D HDR(0) "RTN","DGOTHFS2",228,0) W ! "RTN","DGOTHFS2",229,0) K DGOTHIST "RTN","DGOTHFS2",230,0) S DGELHIST=$$CROSS^DGOTHINQ(IEN33,.DGOTHIST) "RTN","DGOTHFS2",231,0) ;go through all the eligibility history and only display date starting from Feb. 20,2020 "RTN","DGOTHFS2",232,0) ;3200220 is the Release Date of EXPANDED MH CARE NON-ENROLLEE "RTN","DGOTHFS2",233,0) S DGRECNUM="" F S DGRECNUM=$O(DGOTHIST(IEN33,DGRECNUM)) Q:DGRECNUM="" D Q:DGQ "RTN","DGOTHFS2",234,0) . I $Y>(IOSL-4) W ! D PAUSE(.DGQ) Q:DGQ D PTHDR,LINE(0) W !! D HDR(1) "RTN","DGOTHFS2",235,0) . S DGLINE=DGOTHIST(IEN33,DGRECNUM) "RTN","DGOTHFS2",236,0) . S DGOTHTYP=$$OTHTYP^DGOTHINQ($P(DGLINE,U)) "RTN","DGOTHFS2",237,0) . W $S($P(DGLINE,U)="":"UNKNOWN",+DGOTHTYP:"EXPANDED MH CARE NON-ENROLLEE"_" ("_$P(DGLINE,U)_")",1:$P(DGLINE,U)) "RTN","DGOTHFS2",238,0) . I $P(DGLINE,U)="EXPANDED MH CARE NON-ENROLLEE" W " (N/A)" "RTN","DGOTHFS2",239,0) . W ?60,$$FMTE^XLFDT($P(DGLINE,U,2),"5Z") "RTN","DGOTHFS2",240,0) . W ! "RTN","DGOTHFS2",241,0) ;break before going back to parent menu "RTN","DGOTHFS2",242,0) I DGSORT("RTYPE")="E" W !!,"<< end of report >>" D ASKCONT^DGOTHFSM(0) W @IOF "RTN","DGOTHFS2",243,0) Q "RTN","DGOTHFS2",244,0) ; "RTN","DGOTHFS2",245,0) OTHREGDT(DGIEN33) ;determine the original date the former OTH service member become EXPANDED MH CARE NON-ENROLLEE "RTN","DGOTHFS2",246,0) ;return the original OTH registration date "RTN","DGOTHFS2",247,0) N DGFOUND,DGTOTREC,DGRECNUM,DGOTHARR,DGOTHREGDT,DGERR,DGREGDT,II "RTN","DGOTHFS2",248,0) S (DGFOUND,DGTOTREC)=0 "RTN","DGOTHFS2",249,0) S DGTOTREC=$P(^DGOTH(33,DGIEN33,2,0),U,4) "RTN","DGOTHFS2",250,0) Q:+DGTOTREC<1 "RTN","DGOTHFS2",251,0) F II=1:1:DGTOTREC S DGREGDT(II)="" "RTN","DGOTHFS2",252,0) S DGRECNUM="" F S DGRECNUM=$O(DGREGDT(DGRECNUM)) Q:DGRECNUM=""!(DGFOUND) D "RTN","DGOTHFS2",253,0) . K DGOTHARR,DGERR "RTN","DGOTHFS2",254,0) . D GETS^DIQ(33,DGIEN33_",","2*","IE","DGOTHARR","DGERR") "RTN","DGOTHFS2",255,0) . Q:$D(DGERR) "RTN","DGOTHFS2",256,0) . ;check if the eligibility is EXPANDED MH CARE NON-ENROLLEE "RTN","DGOTHFS2",257,0) . I DGOTHARR(33.02,DGRECNUM_","_DGIEN33_",",.02,"E")="EXPANDED MH CARE NON-ENROLLEE" D "RTN","DGOTHFS2",258,0) . . ;the original OTH registration date "RTN","DGOTHFS2",259,0) . . S DGOTHREGDT=$G(DGOTHARR(33.02,DGRECNUM_","_DGIEN33_",",.01,"I")) "RTN","DGOTHFS2",260,0) . . S DGFOUND=1 "RTN","DGOTHFS2",261,0) Q DGOTHREGDT\1 "RTN","DGOTHFS2",262,0) ; "RTN","DGOTHFS2",263,0) ENCTR(DFN,DGSORT) ;display patient's checked out encounters "RTN","DGOTHFS2",264,0) N DGENCTR,DGDIV,DGENCTRDT,DGTOTENC,TITLE "RTN","DGOTHFS2",265,0) ;display this piece of information to its own page so that the report will not look cluttered "RTN","DGOTHFS2",266,0) D PAUSE(.DGQ) Q:DGQ D PTHDR,LINE(0) "RTN","DGOTHFS2",267,0) D ENCHDR(0),ENCTRCOL,LINE(1) "RTN","DGOTHFS2",268,0) ;check if there any past Outpatient Encounter entry for this patient in the selected date range "RTN","DGOTHFS2",269,0) D CHKTREAT(.DGENCTR,DFN,DGSORT("DGBEG"),DGSORT("DGEND"),.VAUTD) "RTN","DGOTHFS2",270,0) S DGTOTENC=0 "RTN","DGOTHFS2",271,0) I '$D(DGENCTR) W !!,">> NO DATA FOUND FROM "_$$FMTE^XLFDT(DGSORT("DGBEG"),"5ZF")_" TO "_$$FMTE^XLFDT(DGSORT("DGEND"),"5ZF")_"." "RTN","DGOTHFS2",272,0) E D "RTN","DGOTHFS2",273,0) . S DGDIV="" F S DGDIV=$O(DGENCTR(DGDIV)) Q:DGDIV="" D Q:DGQ "RTN","DGOTHFS2",274,0) . . S DGENCTRDT="" F S DGENCTRDT=$O(DGENCTR(DGDIV,DGENCTRDT)) Q:DGENCTRDT="" D Q:DGQ "RTN","DGOTHFS2",275,0) . . . ;check if the encounter date is between OTH registration date and the primary eligibility changed date "RTN","DGOTHFS2",276,0) . . . Q:'$$CHKDATE^DGOTHFSM(DGENCTRDT\1,.DGSORT) "RTN","DGOTHFS2",277,0) . . . I $Y>(IOSL-4) W ! D PAUSE(.DGQ) Q:DGQ D PTHDR,LINE(0),ENCHDR(1),ENCTRCOL,LINE(1) "RTN","DGOTHFS2",278,0) . . . W !,$E($P(DGENCTR(DGDIV,DGENCTRDT),U,3),1,28) ;clinic name "RTN","DGOTHFS2",279,0) . . . W ?30,$E($P(DGENCTR(DGDIV,DGENCTRDT),U,4),1,26) ;clinic stop code "RTN","DGOTHFS2",280,0) . . . W ?57,$P(DGENCTR(DGDIV,DGENCTRDT),U,2) ;Division "RTN","DGOTHFS2",281,0) . . . W ?67,$$FMTE^XLFDT(DGENCTRDT,"5MZF") ;Appt. Date/Time "RTN","DGOTHFS2",282,0) . . . W ?85,$E($P(DGENCTR(DGDIV,DGENCTRDT),U,5),1,20) ;user last updated/edited the entry "RTN","DGOTHFS2",283,0) . . . S DGTOTENC=DGTOTENC+1 "RTN","DGOTHFS2",284,0) . . . Q:DGQ "RTN","DGOTHFS2",285,0) . . Q:DGQ "RTN","DGOTHFS2",286,0) . Q:DGQ "RTN","DGOTHFS2",287,0) W ! D LINE(1) "RTN","DGOTHFS2",288,0) Q:DGQ "RTN","DGOTHFS2",289,0) W !!,"Total Number of Encounter: ",DGTOTENC "RTN","DGOTHFS2",290,0) Q "RTN","DGOTHFS2",291,0) ; "RTN","DGOTHFS2",292,0) ENCTRCOL ;display encounter column name "RTN","DGOTHFS2",293,0) W !,"Clinic Name",?30,"Clinic Stop",?57,"Division",?67,"Appt. Date/Time",?85,"Last Updated By",! "RTN","DGOTHFS2",294,0) Q "RTN","DGOTHFS2",295,0) ; "RTN","DGOTHFS2",296,0) ENCHDR(FLAG) ;Encounter Header "RTN","DGOTHFS2",297,0) S TITLE="PATIENT'S CHECKED OUT ENCOUNTERS"_$S(FLAG:" - Continuation",1:"") "RTN","DGOTHFS2",298,0) W !!,?132-$L(TITLE)\2,TITLE,! "RTN","DGOTHFS2",299,0) D DTRANGE "RTN","DGOTHFS2",300,0) D LINE(1) "RTN","DGOTHFS2",301,0) Q "RTN","DGOTHFS2",302,0) ; "RTN","DGOTHFS2",303,0) DTRANGE ;display date range "RTN","DGOTHFS2",304,0) N DTRANGE "RTN","DGOTHFS2",305,0) S DTRANGE="Date Range: "_$$FMTE^XLFDT(DGSORT("DGBEG"),"5ZF")_" - "_$$FMTE^XLFDT(DGSORT("DGEND"),"5ZF") "RTN","DGOTHFS2",306,0) W ?132-$L(DTRANGE)\2,DTRANGE,! "RTN","DGOTHFS2",307,0) Q "RTN","DGOTHFS2",308,0) ; "RTN","DGOTHFS2",309,0) RX(DFN,DGSORT) ;display patient's released prescription "RTN","DGOTHFS2",310,0) N DGRXIEN,TITLE,DGRXDIV,DGRELDATE,DGRXNUM,DGTOTALRX,DGCPTIER,DGDRUGIEN,DGRXISDT "RTN","DGOTHFS2",311,0) K ^TMP($J,"OTHFSMR2") ;patient's RX information from File #52 "RTN","DGOTHFS2",312,0) ;display this piece of information to its own page so that the report will not look cluttered "RTN","DGOTHFS2",313,0) D PAUSE(.DGQ) Q:DGQ D PTHDR,LINE(0) "RTN","DGOTHFS2",314,0) D RXHDR(0),RXCOL,LINE(1) "RTN","DGOTHFS2",315,0) ;get the medication profile of a patient from PRESCRIPTION file (#52) "RTN","DGOTHFS2",316,0) D RX^PSO52API(DFN,"OTHFSMR2",,,"2,R",,) "RTN","DGOTHFS2",317,0) S DGTOTALRX=$P(^TMP($J,"OTHFSMR2",DFN,0),U) "RTN","DGOTHFS2",318,0) ;check if patient had any prescription "RTN","DGOTHFS2",319,0) I DGTOTALRX<1 D Q "RTN","DGOTHFS2",320,0) . W !!,">> "_$P(^TMP($J,"OTHFSMR2",DFN,0),U,2)_" FROM "_$$FMTE^XLFDT(DGSORT("DGBEG"),"5ZF")_" TO "_$$FMTE^XLFDT(DGSORT("DGEND"),"5ZF")_"." "RTN","DGOTHFS2",321,0) . S DGTOTALRX=0 "RTN","DGOTHFS2",322,0) . W ! D LINE(1) W ! "RTN","DGOTHFS2",323,0) . W !,"Total Number of Rx: ",DGTOTALRX,!!! "RTN","DGOTHFS2",324,0) . W !!,"<< end of report >>" "RTN","DGOTHFS2",325,0) . D ASKCONT^DGOTHFSM(0) W @IOF "RTN","DGOTHFS2",326,0) ;otherwise, traverse and display all patients RX's "RTN","DGOTHFS2",327,0) S DGRXNUM="" F S DGRXNUM=$O(^TMP($J,"OTHFSMR2","B",DGRXNUM)) Q:DGRXNUM="" D Q:DGQ "RTN","DGOTHFS2",328,0) . S DGRXIEN="" F S DGRXIEN=$O(^TMP($J,"OTHFSMR2","B",DGRXNUM,DGRXIEN)) Q:DGRXIEN="" D Q:DGQ "RTN","DGOTHFS2",329,0) . . I $Y>(IOSL-4) W ! D PAUSE(.DGQ) Q:DGQ D PTHDR,LINE(0),RXHDR(1),RXCOL,LINE(1) "RTN","DGOTHFS2",330,0) . . S DGRELDATE=$P(^TMP($J,"OTHFSMR2",DFN,DGRXIEN,31),U) ;Rx Released Date "RTN","DGOTHFS2",331,0) . . ;quit if original Rx Released Date within date range from the time patient became OTH to PE is verified "RTN","DGOTHFS2",332,0) . . I '$$CHKDATE^DGOTHFSM(DGRELDATE\1,.DGSORT) S DGTOTALRX=DGTOTALRX-1 Q "RTN","DGOTHFS2",333,0) . . ;otherwise, extract original rx released date/time data and display "RTN","DGOTHFS2",334,0) . . D ORGRX(DFN,DGRXIEN) "RTN","DGOTHFS2",335,0) . . W ! "RTN","DGOTHFS2",336,0) . . Q:DGQ "RTN","DGOTHFS2",337,0) . Q:DGQ "RTN","DGOTHFS2",338,0) W:DGTOTALRX<1 !,">> NO DATA FOUND FROM "_$$FMTE^XLFDT(DGSORT("DGBEG"),"5ZF")_" TO "_$$FMTE^XLFDT(DGSORT("DGEND"),"5ZF")_".",! "RTN","DGOTHFS2",339,0) D LINE(1) W ! "RTN","DGOTHFS2",340,0) W:DGTOTALRX>0 !,"Total Number of Rx: ",DGTOTALRX,!!! "RTN","DGOTHFS2",341,0) K ^TMP($J,"OTHFSMR2") "RTN","DGOTHFS2",342,0) W !!,"<< end of report >>" "RTN","DGOTHFS2",343,0) Q:DGQ "RTN","DGOTHFS2",344,0) D ASKCONT^DGOTHFSM(0) W @IOF "RTN","DGOTHFS2",345,0) Q "RTN","DGOTHFS2",346,0) ; "RTN","DGOTHFS2",347,0) RXCOL ;display Rx column name "RTN","DGOTHFS2",348,0) W !,"RX #",?16,"Copay Tier",?30,"# of Refills",?44,"Days Supply",?57,"Division",?67,"Fill Date",?80,"Rx Release Date",! "RTN","DGOTHFS2",349,0) Q "RTN","DGOTHFS2",350,0) ; "RTN","DGOTHFS2",351,0) RXHDR(FLAG) ;Released Prescription Header "RTN","DGOTHFS2",352,0) S TITLE="PATIENT'S RELEASED PRESCRIPTION"_$S(FLAG:" - Continuation",1:"") "RTN","DGOTHFS2",353,0) W !!,?132-$L(TITLE)\2,TITLE,! "RTN","DGOTHFS2",354,0) D DTRANGE "RTN","DGOTHFS2",355,0) D LINE(1) "RTN","DGOTHFS2",356,0) Q "RTN","DGOTHFS2",357,0) ; "RTN","DGOTHFS2",358,0) ORGRX(DFN,DGRXIEN) ;extract Original Rx for a patient and display "RTN","DGOTHFS2",359,0) N DGTOTRF,DGREF,REFDATA,JJ,DGRFRELDT "RTN","DGOTHFS2",360,0) ;display original Rx information "RTN","DGOTHFS2",361,0) W $P(^TMP($J,"OTHFSMR2",DFN,DGRXIEN,.01),U) ;external Rx# "RTN","DGOTHFS2",362,0) D CPTIER ;extract the copay tier "RTN","DGOTHFS2",363,0) W ?20,DGCPTIER ;Copay Tier "RTN","DGOTHFS2",364,0) W ?30,$J($P(^TMP($J,"OTHFSMR2",DFN,DGRXIEN,9),U),4) ;# of refills "RTN","DGOTHFS2",365,0) W ?43,$J($P(^TMP($J,"OTHFSMR2",DFN,DGRXIEN,8),U),5) ;days supply "RTN","DGOTHFS2",366,0) D SITE(0) ;extract the site where Rx's released "RTN","DGOTHFS2",367,0) W ?57,DGRXDIV ;Division "RTN","DGOTHFS2",368,0) W ?67,$$FMTE^XLFDT($P(^TMP($J,"OTHFSMR2",DFN,DGRXIEN,22),U),"5Z") ;Fill Date "RTN","DGOTHFS2",369,0) W ?80,$S(+DGRELDATE>1:$$FMTE^XLFDT(DGRELDATE,"5MZF"),1:"Rx Not Released") ;current rx released date/time "RTN","DGOTHFS2",370,0) ;check if there are any refills for this Rx "RTN","DGOTHFS2",371,0) ;if there are and the released date is within the user specified date range, then include it into the report "RTN","DGOTHFS2",372,0) S DGTOTRF=+$P(^TMP($J,"OTHFSMR2",DFN,DGRXIEN,"RF",0),U) "RTN","DGOTHFS2",373,0) ;quit if no refills found for this Rx "RTN","DGOTHFS2",374,0) Q:+DGTOTRF<1 "RTN","DGOTHFS2",375,0) ;otherwise, display the refill Rx as well "RTN","DGOTHFS2",376,0) F JJ=1:1:DGTOTRF D "RTN","DGOTHFS2",377,0) . ;rx refill released date/time "RTN","DGOTHFS2",378,0) . S DGRFRELDT=$P(^TMP($J,"OTHFSMR2",DFN,DGRXIEN,"RF",JJ,17),U) "RTN","DGOTHFS2",379,0) . ;quit if rx refill released date not within the user specified date range "RTN","DGOTHFS2",380,0) . Q:'$$CHKDATE^DGOTHFSM(+DGRFRELDT\1,.DGSORT) "RTN","DGOTHFS2",381,0) . W ! "RTN","DGOTHFS2",382,0) . W ?43,$J($P(^TMP($J,"OTHFSMR2",DFN,DGRXIEN,"RF",JJ,1.1),U),5) ;days supply "RTN","DGOTHFS2",383,0) . D SITE(1) ;extract the site where Rx's released "RTN","DGOTHFS2",384,0) . W ?57,DGRXDIV ;Division "RTN","DGOTHFS2",385,0) . W ?67,$$FMTE^XLFDT($P(^TMP($J,"OTHFSMR2",DFN,DGRXIEN,"RF",JJ,.01),U),"5Z") ;Fill Date "RTN","DGOTHFS2",386,0) . W ?80,$S(+DGRFRELDT>1:$$FMTE^XLFDT($P(^TMP($J,"OTHFSMR2",DFN,DGRXIEN,"RF",JJ,17),U),"5MZF"),1:"Rx Not Released") "RTN","DGOTHFS2",387,0) Q "RTN","DGOTHFS2",388,0) ; "RTN","DGOTHFS2",389,0) CPTIER ;extract Rx Copay Tier "RTN","DGOTHFS2",390,0) K ^TMP($J,"OTHCPTIER"),DGCPTIER,DGDRUGIEN "RTN","DGOTHFS2",391,0) S DGDRUGIEN=$P(^TMP($J,"OTHFSMR2",DFN,DGRXIEN,6),U) "RTN","DGOTHFS2",392,0) D NDF^PSS50(DGDRUGIEN,"","","","","OTHCPTIER") "RTN","DGOTHFS2",393,0) ;look up the tier of the prescription "RTN","DGOTHFS2",394,0) ;returns the tier level of the specified prescription "RTN","DGOTHFS2",395,0) ;default tier is always 2 "RTN","DGOTHFS2",396,0) S DGCPTIER=$P(^TMP($J,"OTHCPTIER",DGDRUGIEN,20),U) "RTN","DGOTHFS2",397,0) S DGCPTIER=$S(DGCPTIER:$P($$CPTIER^PSNAPIS(DGCPTIER,DT,DGDRUGIEN,1),U),1:2) "RTN","DGOTHFS2",398,0) K ^TMP($J,"OTHCPTIER") "RTN","DGOTHFS2",399,0) Q "RTN","DGOTHFS2",400,0) ; "RTN","DGOTHFS2",401,0) SITE(FLAG) ;site where Rx's released "RTN","DGOTHFS2",402,0) K ^TMP($J,"OTHFSMSITE"),DGRXDIV ;site where RX's released "RTN","DGOTHFS2",403,0) I FLAG<1 S DGRXDIV=$P(^TMP($J,"OTHFSMR2",DFN,DGRXIEN,20),U) "RTN","DGOTHFS2",404,0) E S DGRXDIV=$P(^TMP($J,"OTHFSMR2",DFN,DGRXIEN,"RF",JJ,8),U) "RTN","DGOTHFS2",405,0) D PSS^PSO59(DGRXDIV,,"OTHFSMSITE") "RTN","DGOTHFS2",406,0) S DGRXDIV=^TMP($J,"OTHFSMSITE",DGRXDIV,.06) "RTN","DGOTHFS2",407,0) K ^TMP($J,"OTHFSMSITE") "RTN","DGOTHFS2",408,0) Q "RTN","DGOTHFS2",409,0) ; "RTN","DGOTHFS2",410,0) LINE(FLAG) ;prints double dash line "RTN","DGOTHFS2",411,0) N LINE "RTN","DGOTHFS2",412,0) I FLAG<1 F LINE=1:1:132 W "=" "RTN","DGOTHFS2",413,0) E F LINE=1:1:132 W "-" "RTN","DGOTHFS2",414,0) Q "RTN","DGOTHFS2",415,0) ; "RTN","DGOTHFS2",416,0) PTHDR(TITLE) ;patient name and DOB header "RTN","DGOTHFS2",417,0) S TITLE=$G(TITLE) "RTN","DGOTHFS2",418,0) I $G(TRM)!('$G(TRM)&DGPAGE) W @IOF "RTN","DGOTHFS2",419,0) I $L(TITLE) W ?132-$L(TITLE)\2,TITLE W !! "RTN","DGOTHFS2",420,0) S DGPAGE=$G(DGPAGE)+1 "RTN","DGOTHFS2",421,0) W "Patient Name: ",DGPTNM_" ("_DGPID_")",?112,"DOB: ",$P(VADM(3),U,2),! "RTN","DGOTHFS2",422,0) Q "RTN","DGOTHFS2",423,0) ; "RTN","DGOTHFS2",424,0) HDR(FLAG) ;Primary Eligibility History header "RTN","DGOTHFS2",425,0) N TITLE "RTN","DGOTHFS2",426,0) S TITLE="PRIMARY ELIGIBILITY/EXPANDED CARE TYPE HISTORY"_$S(FLAG:" - Continuation",1:"") "RTN","DGOTHFS2",427,0) W ?132-$L(TITLE)\2,TITLE,! "RTN","DGOTHFS2",428,0) D LINE(1) "RTN","DGOTHFS2",429,0) W "Primary Eligibility",?60,"Date of Change",! "RTN","DGOTHFS2",430,0) D LINE(1) "RTN","DGOTHFS2",431,0) Q "RTN","DGOTHFS2",432,0) ; "RTN","DGOTHFS2",433,0) ;Check if patient should be included in report, using OUTPATIENT ENCOUNTER file, and return division "RTN","DGOTHFS2",434,0) CHKTREAT(RET,DFN,DGDTF,DGDTT,ARRDIV) ; "RTN","DGOTHFS2",435,0) ; "RTN","DGOTHFS2",436,0) ;Find all divisions within the user-selected date range, and check input array ARRDIV "RTN","DGOTHFS2",437,0) ; "RTN","DGOTHFS2",438,0) ;Input: "RTN","DGOTHFS2",439,0) ; DFN=IEN in file #2 "RTN","DGOTHFS2",440,0) ; DGDTF='From' date entered by user "RTN","DGOTHFS2",441,0) ; DGDTT='To' date entered by user "RTN","DGOTHFS2",442,0) ; ARRDIV is in the format output by utility VAUTOMA "RTN","DGOTHFS2",443,0) ;Output: "RTN","DGOTHFS2",444,0) ; RET(DIVISION#,DATE OF ENCOUNTER)=Name of division^Station #^Clinic Name^Clinic Stop Code^Edited Last By "RTN","DGOTHFS2",445,0) ; Example: "RTN","DGOTHFS2",446,0) ; RET(1,3190425)="NORTHAMPTON^666^542^EMERGENCY DEPT^User one" "RTN","DGOTHFS2",447,0) ; RET(7,3190413)="PITTSFIELD^777^542^EMERGENCY DEPT^User one" "RTN","DGOTHFS2",448,0) ; RET(7,3190425)="PITTSFIELD^888542^EMERGENCY DEPT^User one" "RTN","DGOTHFS2",449,0) ; "RTN","DGOTHFS2",450,0) N DGCO,DGDIV,DGDT,DGIEN,DGOUT,DGSTPCODE,DGCLNCNME,DGSTA,DGLSTEDTBY "RTN","DGOTHFS2",451,0) S DGDT="" F S DGDT=$O(^SCE("ADFN",DFN,DGDT),-1) Q:'DGDT!(DGDTDGDTT) "RTN","DGOTHFS2",452,0) . S DGIEN=0 F S DGIEN=$O(^SCE("ADFN",DFN,DGDT,DGIEN)) Q:'DGIEN D "RTN","DGOTHFS2",453,0) . . K DGOUT D GETS^DIQ(409.68,DGIEN_",",".03;.04;.11;.12;.13;101","IE","DGOUT") Q:$G(DGOUT(409.68,DGIEN_",",.12,"E"))'="CHECKED OUT" "RTN","DGOTHFS2",454,0) . . S DGDIV=$G(DGOUT(409.68,DGIEN_",",.11,"I")) Q:DGDIV="" "RTN","DGOTHFS2",455,0) . . S DGSTA=$$STA^XUAF4($$GET1^DIQ(40.8,DGDIV_",",.07,"I")) "RTN","DGOTHFS2",456,0) . . S DGSTPCODE=$G(DGOUT(409.68,DGIEN_",",.03,"E")) "RTN","DGOTHFS2",457,0) . . S DGCLNCNME=$G(DGOUT(409.68,DGIEN_",",.04,"E")) "RTN","DGOTHFS2",458,0) . . S DGLSTEDTBY=$G(DGOUT(409.68,DGIEN_",",101,"E")) "RTN","DGOTHFS2",459,0) . . I $G(ARRDIV)=1 D CHKTRSET Q "RTN","DGOTHFS2",460,0) . . D:$D(ARRDIV(DGDIV)) CHKTRSET "RTN","DGOTHFS2",461,0) Q "RTN","DGOTHFS2",462,0) ; "RTN","DGOTHFS2",463,0) CHKTRSET ; "RTN","DGOTHFS2",464,0) S RET(DGDIV,DGDT)=DGOUT(409.68,DGIEN_",",.11,"E")_U_DGSTA_U_DGCLNCNME_U_DGSTPCODE_U_DGLSTEDTBY "RTN","DGOTHFS2",465,0) Q "RTN","DGOTHFS2",466,0) ; "RTN","DGOTHFS2",467,0) PAUSE(DGQ) ; pause screen display "RTN","DGOTHFS2",468,0) N J "RTN","DGOTHFS2",469,0) F J=1:1 Q:($Y>(23-2)) W ! "RTN","DGOTHFS2",470,0) I $G(DGPAGE)>0,TRM,$$E("Press to continue or '^' to exit:")<1 S DGQ=1 "RTN","DGOTHFS2",471,0) Q "RTN","DGOTHFS2",472,0) ; "RTN","DGOTHFS2",473,0) E(MSG) ; ----- ask user to press enter to continue "RTN","DGOTHFS2",474,0) ; Return: -2:Time-out; -1:'^'-out 1:anything else "RTN","DGOTHFS2",475,0) S MSG=$G(MSG) "RTN","DGOTHFS2",476,0) N X,Y,Z,DIR,DIROUT,DIRUT,DTOUT,DUOUT "RTN","DGOTHFS2",477,0) S DIR(0)="EA" "RTN","DGOTHFS2",478,0) I $L(MSG) S DIR("A")=MSG "RTN","DGOTHFS2",479,0) D ^DIR "RTN","DGOTHFS2",480,0) S X=$S($D(DTOUT):-2,$D(DUOUT):-1,1:1) "RTN","DGOTHFS2",481,0) Q X "RTN","DGOTHFS2",482,0) ; "RTN","DGOTHFSM") 0^1^B165402370 "RTN","DGOTHFSM",1,0) DGOTHFSM ;SLC/RM - FORMER OTH PATIENT ELIGIBILITY CHANGE REPORT ; July 13, 2020@09:44am "RTN","DGOTHFSM",2,0) ;;5.3;Registration;**1025**;Aug 13, 1993;Build 11 "RTN","DGOTHFSM",3,0) ; "RTN","DGOTHFSM",4,0) ; "RTN","DGOTHFSM",5,0) ;ICR# TYPE REFERENCE TO "RTN","DGOTHFSM",6,0) ;----- ---- --------------------- "RTN","DGOTHFSM",7,0) ;10086 Sup HOME^%ZIS "RTN","DGOTHFSM",8,0) ;10089 Sup ^%ZISC "RTN","DGOTHFSM",9,0) ;10063 Sup $$S^%ZTLOAD "RTN","DGOTHFSM",10,0) ;10024 Sup WAIT^DICD "RTN","DGOTHFSM",11,0) ;2056 Sup $$GET1^DIQ ; GETS^DIQ "RTN","DGOTHFSM",12,0) ;10026 Sup ^DIR "RTN","DGOTHFSM",13,0) ;10061 Sup ELIG^VADPT ; KVAR^VADPT "RTN","DGOTHFSM",14,0) ;10112 Sup $$SITE^VASITE "RTN","DGOTHFSM",15,0) ;10103 Sup $$FMTE^XLFDT ; $$NOW^XLFDT "RTN","DGOTHFSM",16,0) ;10104 Sup $$CJ^XLFSTR "RTN","DGOTHFSM",17,0) ;2171 Sup $$STA^XUAF4 "RTN","DGOTHFSM",18,0) ;1519 Sup EN^XUTMDEVQ "RTN","DGOTHFSM",19,0) ;10104 Sup $$CJ^XLFSTR "RTN","DGOTHFSM",20,0) ; "RTN","DGOTHFSM",21,0) ;No direct call "RTN","DGOTHFSM",22,0) Q "RTN","DGOTHFSM",23,0) ; "RTN","DGOTHFSM",24,0) ;Entry point for DG FORMER OTH PATIENTS ELIG. CHANGE REPORT option "RTN","DGOTHFSM",25,0) MAIN ; Initial Interactive Processing "RTN","DGOTHFSM",26,0) N DGSORT ;array of report parameters "RTN","DGOTHFSM",27,0) N ZTDESC,ZTQUEUED,ZTREQ,ZTSAVE,ZTSTOP,%ZIS "RTN","DGOTHFSM",28,0) ;check for database "RTN","DGOTHFSM",29,0) I '+$O(^DGOTH(33,"B","")) W !!!,$$CJ^XLFSTR(">>> No OTH records have been found. <<<",80) D ASKCONT(0) Q "RTN","DGOTHFSM",30,0) W @IOF "RTN","DGOTHFSM",31,0) W "FORMER OTH PATIENT ELIGIBILITY CHANGE REPORT" "RTN","DGOTHFSM",32,0) W !!,"This report identifies Former Service Members whose Primary Eligibility" "RTN","DGOTHFSM",33,0) W !,"changed from EXPANDED MH CARE NON-ENROLLEE to a new Primary Eligibility" "RTN","DGOTHFSM",34,0) W !,"with a VERIFIED eligibility status. These patients are no longer treated" "RTN","DGOTHFSM",35,0) W !,"under the Other Than Honorable (OTH) authority (VHA Directive 1601A.02)." "RTN","DGOTHFSM",36,0) W !!,"*** THIS REPORT REQUIRES 132 COLUMN OUTPUT TO PRINT CORRECTLY ***" "RTN","DGOTHFSM",37,0) W !!,"At the DEVICE: prompt please accept the default value of '0;132;99999'" "RTN","DGOTHFSM",38,0) W !,"This is to deliberately avoid undesired wrapping problems of the data." "RTN","DGOTHFSM",39,0) W !!,"Enter Primary Eligibility Changed Date: " "RTN","DGOTHFSM",40,0) ;Prompt user for FROM Date of Eligibility Change "RTN","DGOTHFSM",41,0) I '$$DATEFROM Q "RTN","DGOTHFSM",42,0) ;Prompt user for TO Date of Eligibility Change "RTN","DGOTHFSM",43,0) I '$$DATETO Q "RTN","DGOTHFSM",44,0) ;prompt for device "RTN","DGOTHFSM",45,0) W ! "RTN","DGOTHFSM",46,0) S %ZIS="" "RTN","DGOTHFSM",47,0) S %ZIS("B")="0;132;99999" "RTN","DGOTHFSM",48,0) S ZTSAVE("DGSORT(")="" "RTN","DGOTHFSM",49,0) S X="FORMER OTH PATIENT ELIGIBILITY CHANGE REPORT" "RTN","DGOTHFSM",50,0) D EN^XUTMDEVQ("START^DGOTHFSM",X,.ZTSAVE,.%ZIS) "RTN","DGOTHFSM",51,0) D HOME^%ZIS "RTN","DGOTHFSM",52,0) Q "RTN","DGOTHFSM",53,0) ; "RTN","DGOTHFSM",54,0) DATEFROM() ;prompt for FROM Date of Service "RTN","DGOTHFSM",55,0) N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGBEGDT,DGSTRTDT "RTN","DGOTHFSM",56,0) S DGBEGDT=3200220 ;February 20,2020 is the date OTH project was released "RTN","DGOTHFSM",57,0) S DGDIRA=" Start with Date: " "RTN","DGOTHFSM",58,0) S DGDIRB=$$FMTE^XLFDT(3200220) "RTN","DGOTHFSM",59,0) S DGDIRH="^D HELP^DGOTHFSM(1)" "RTN","DGOTHFSM",60,0) S DGDIRO="DA^"_DGBEGDT_":DT:EX" "RTN","DGOTHFSM",61,0) S DGASK=$$ANSWER(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGOTHFSM",62,0) I DGASK>0 S DGSORT("DGBEG")=$S(DGASK0 "RTN","DGOTHFSM",64,0) ; "RTN","DGOTHFSM",65,0) DATETO() ;prompt for TO Date of Service "RTN","DGOTHFSM",66,0) N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGDTEND "RTN","DGOTHFSM",67,0) S DGDIRA=" End with Date : " "RTN","DGOTHFSM",68,0) S DGDIRB="TODAY" "RTN","DGOTHFSM",69,0) S DGDIRH="^D HELP^DGOTHFSM(1)" "RTN","DGOTHFSM",70,0) S DGDTEND=DGSORT("DGBEG") "RTN","DGOTHFSM",71,0) S DGDIRO="DA^"_DGSORT("DGBEG")_":DT:EX" "RTN","DGOTHFSM",72,0) S DGASK=$$ANSWER(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGOTHFSM",73,0) I DGASK>0 S DGSORT("DGEND")=DGASK "RTN","DGOTHFSM",74,0) Q DGASK>0 "RTN","DGOTHFSM",75,0) ; "RTN","DGOTHFSM",76,0) ANSWER(DGDIRA,DGDIRB,DGDIR0,DGDIRH) ; "RTN","DGOTHFSM",77,0) ; Input "RTN","DGOTHFSM",78,0) ; DGDIR0 - DIR(0) string "RTN","DGOTHFSM",79,0) ; DGDIRA - DIR("A") string "RTN","DGOTHFSM",80,0) ; DGDIRB - DIR("B") string "RTN","DGOTHFSM",81,0) ; DGDIRH - DIR("?") string "RTN","DGOTHFSM",82,0) ; Output "RTN","DGOTHFSM",83,0) ; Function Value - Internal value returned from ^DIR or -1 if user "RTN","DGOTHFSM",84,0) ; up-arrows, double up-arrows or the read times out. "RTN","DGOTHFSM",85,0) N X,Y,Z,DIR,DIROUT,DIRUT,DTOUT,DUOUT "RTN","DGOTHFSM",86,0) I $D(DGDIR0) S DIR(0)=DGDIR0 "RTN","DGOTHFSM",87,0) I $D(DGDIRA) M DIR("A")=DGDIRA "RTN","DGOTHFSM",88,0) I $G(DGDIRB)]"" S DIR("B")=DGDIRB "RTN","DGOTHFSM",89,0) I $D(DGDIRH) S DIR("?")=DGDIRH,DIR("??")=DGDIRH "RTN","DGOTHFSM",90,0) D ^DIR K DIR "RTN","DGOTHFSM",91,0) S Z=$S($D(DTOUT):-2,$D(DUOUT):-1,$D(DIROUT):-1,1:"") "RTN","DGOTHFSM",92,0) I Z="" S Z=$S(Y=-1:"",X="@":"@",1:$P(Y,U)) Q Z "RTN","DGOTHFSM",93,0) I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1 "RTN","DGOTHFSM",94,0) Q $S(X="@":"@",1:$P(Y,U)) "RTN","DGOTHFSM",95,0) ; "RTN","DGOTHFSM",96,0) HELP(DGSEL) ;provide extended DIR("?") help text. "RTN","DGOTHFSM",97,0) ; "RTN","DGOTHFSM",98,0) ; Input: DGSEL - prompt var for help text word selection "RTN","DGOTHFSM",99,0) ; Output: none "RTN","DGOTHFSM",100,0) ; "RTN","DGOTHFSM",101,0) N DGOTHDT "RTN","DGOTHFSM",102,0) S DGOTHDT=3200220 "RTN","DGOTHFSM",103,0) I (X="?")!(X="??") D Q "RTN","DGOTHFSM",104,0) . W !," Enter the date when the Primary Eligibility changed from" "RTN","DGOTHFSM",105,0) . W !," EXPANDED MH CARE NON-ENROLLEE to its new primary eligibility." "RTN","DGOTHFSM",106,0) . W ! D HELP1 "RTN","DGOTHFSM",107,0) . W ! D HELP2 "RTN","DGOTHFSM",108,0) . I $D(Y) K Y "RTN","DGOTHFSM",109,0) W !," The Date you entered is not valid." "RTN","DGOTHFSM",110,0) I $D(Y),YDT D HELP2 I $D(Y) K Y Q "RTN","DGOTHFSM",112,0) Q "RTN","DGOTHFSM",113,0) ; "RTN","DGOTHFSM",114,0) HELP1 ; "RTN","DGOTHFSM",115,0) W !," The earliest date that you can enter is February 20,2020." "RTN","DGOTHFSM",116,0) W !," This is the date the new Primary Eligibility code" "RTN","DGOTHFSM",117,0) W !," EXPANDED MH CARE NON-ENROLLEE became available." "RTN","DGOTHFSM",118,0) Q "RTN","DGOTHFSM",119,0) ; "RTN","DGOTHFSM",120,0) HELP2 ; "RTN","DGOTHFSM",121,0) W !," Date cannot be a future date." "RTN","DGOTHFSM",122,0) Q "RTN","DGOTHFSM",123,0) ; "RTN","DGOTHFSM",124,0) START ; compile and print report "RTN","DGOTHFSM",125,0) I $E(IOST)="C" D WAIT^DICD "RTN","DGOTHFSM",126,0) N HERE S HERE=$$SITE^VASITE ;extract the IEN and facility name where the report is run "RTN","DGOTHFSM",127,0) N TRM S TRM=($E(IOST)="C") "RTN","DGOTHFSM",128,0) N DGLIST ;temp global name used for report list "RTN","DGOTHFSM",129,0) N DGOTHIN ;temp global name for INACTIVE OTH patient list "RTN","DGOTHFSM",130,0) S DGLIST=$NA(^TMP($J,"OTHEL")) "RTN","DGOTHFSM",131,0) S DGOTHIN=$NA(^TMP($J,"OTHINACTV")) "RTN","DGOTHFSM",132,0) K @DGLIST,@DGOTHIN "RTN","DGOTHFSM",133,0) D LOOP(.DGSORT,DGLIST,DGOTHIN) "RTN","DGOTHFSM",134,0) I $O(@DGOTHIN@(""))'="" D PRINT(.DGSORT,DGLIST) "RTN","DGOTHFSM",135,0) K @DGLIST,@DGOTHIN "RTN","DGOTHFSM",136,0) D EXIT "RTN","DGOTHFSM",137,0) Q "RTN","DGOTHFSM",138,0) ; "RTN","DGOTHFSM",139,0) LOOP(DGSORT,DGLIST,DGOTHIN) ; "RTN","DGOTHFSM",140,0) N DDASH,DGPAGE,DGDFN,DGIEN33,DGERR,DGOTHARR,DGENCTR,VAUTD,DATA "RTN","DGOTHFSM",141,0) N DGOTHREGDT,DGELIGDATE,DGPTNAME,DGNEWELG,DGPID,DGDOB "RTN","DGOTHFSM",142,0) S $P(DDASH,"=",81)="" "RTN","DGOTHFSM",143,0) S DGPAGE=0 "RTN","DGOTHFSM",144,0) ;gather all registered OTH patients with INACTIVE status only "RTN","DGOTHFSM",145,0) ;patients with INACTIVE OTH status, either the patient received "RTN","DGOTHFSM",146,0) ;VBA adjudication or entered in error "RTN","DGOTHFSM",147,0) D INACTOTH(.DGSORT) "RTN","DGOTHFSM",148,0) ;No INACTIVE OTH patients found, display message and quit "RTN","DGOTHFSM",149,0) I $O(@DGOTHIN@(""))="" D Q "RTN","DGOTHFSM",150,0) . Q:'+$O(^DGOTH(33,"F","")) "RTN","DGOTHFSM",151,0) . D HEADER,COLHEAD "RTN","DGOTHFSM",152,0) . W !!!," >>> No records were found in the selected date range.",!! "RTN","DGOTHFSM",153,0) . W ! D LINE "RTN","DGOTHFSM",154,0) . D ASKCONT(0) "RTN","DGOTHFSM",155,0) ;Otherwise, loop thru all INACTIVE OTH patients temporarily stored in the global and see "RTN","DGOTHFSM",156,0) ;which of this patients received primary eligibility status of VERIFIED "RTN","DGOTHFSM",157,0) ; "RTN","DGOTHFSM",158,0) S VAUTD=1 ;All the divisions in the facility, since we are not prompting user to enter Division "RTN","DGOTHFSM",159,0) S DGDFN="" F S DGDFN=$O(@DGOTHIN@(DGDFN)) Q:DGDFN="" D "RTN","DGOTHFSM",160,0) . S DGIEN33="" F S DGIEN33=$O(@DGOTHIN@(DGDFN,DGIEN33)) Q:DGIEN33="" D "RTN","DGOTHFSM",161,0) . . K DGERR,DGOTHARR,DGENCTR,DATA,DGELIGDATE,DGPTNAME,DGNEWELG,DGOTHREGDT,DGPID,DGDOB "RTN","DGOTHFSM",162,0) . . D GETS^DIQ(2,DGDFN_",",".01;.0905;.361;.3611;.3612","IE","DGOTHARR","DGERR") "RTN","DGOTHFSM",163,0) . . Q:$D(DGERR) "RTN","DGOTHFSM",164,0) . . ;quit if eligibility status not VERIFIED "RTN","DGOTHFSM",165,0) . . Q:$G(DGOTHARR(2,DGDFN_",",.3611,"I"))'="V" "RTN","DGOTHFSM",166,0) . . ;quit if the eligibility changed date not within user-specified date range "RTN","DGOTHFSM",167,0) . . Q:'$$CHKDATE($G(DGOTHARR(2,DGDFN_",",.3612,"I")),.DGSORT) "RTN","DGOTHFSM",168,0) . . ;check if there any past Outpatient Encounter entry for this patient in the selected date range "RTN","DGOTHFSM",169,0) . . S DGOTHREGDT=$G(@DGOTHIN@(DGDFN,DGIEN33)) "RTN","DGOTHFSM",170,0) . . D CHKTREAT^DGPPRP1(.DGENCTR,+DGDFN,DGOTHREGDT,DGSORT("DGEND"),.VAUTD) "RTN","DGOTHFSM",171,0) . . ;quit if no encounter, only collect completed encounter with STATUS=CHECKED OUT "RTN","DGOTHFSM",172,0) . . ;If patient had past encounter on the selected date range but the SITE where the "RTN","DGOTHFSM",173,0) . . ;encounter happen does not belong to the facility/division where the report is run, "RTN","DGOTHFSM",174,0) . . ;the patient will not be displayed into the report "RTN","DGOTHFSM",175,0) . . Q:'$D(DGENCTR) "RTN","DGOTHFSM",176,0) . . ;if all checking above passed, then extract patient name, "RTN","DGOTHFSM",177,0) . . ;PID, New Eligibility Code, SC%, Eligibility Change Date, Station ID "RTN","DGOTHFSM",178,0) . . S DGELIGDATE=$G(DGOTHARR(2,DGDFN_",",.3612,"I")) "RTN","DGOTHFSM",179,0) . . S DGPTNAME=$G(DGOTHARR(2,DGDFN_",",.01,"I")) "RTN","DGOTHFSM",180,0) . . S DGPID=$G(DGOTHARR(2,DGDFN_",",.0905,"I")) "RTN","DGOTHFSM",181,0) . . S DGNEWELG=$G(DGOTHARR(2,DGDFN_",",.361,"E")) "RTN","DGOTHFSM",182,0) . . S DATA=DGPTNAME_U_DGPID_U_DGOTHREGDT_U_DGNEWELG_U_DGELIGDATE "RTN","DGOTHFSM",183,0) . . ;extract the SC% "RTN","DGOTHFSM",184,0) . . S DATA=$$SCPRCT(DGDFN,DATA) "RTN","DGOTHFSM",185,0) . . ;determine if the facility belongs to integrated or non-integrated site "RTN","DGOTHFSM",186,0) . . D CHKINT(.DGENCTR,DATA) "RTN","DGOTHFSM",187,0) Q "RTN","DGOTHFSM",188,0) ; "RTN","DGOTHFSM",189,0) INACTOTH(DGSORT) ;Gather all registered OTH Patients with INACTIVE status within the user-specified date range "RTN","DGOTHFSM",190,0) N DGDFN,DGIEN33,DGERR,DGOTHARR,DGREGDT,DGOTHELDT,DGRECNUM,DGFOUND,DGELGDT,DGSTDT,II,DGTOTREC "RTN","DGOTHFSM",191,0) ;check first the existence of the "F" cross reference "RTN","DGOTHFSM",192,0) I '+$O(^DGOTH(33,"F","")) W !!!,$$CJ^XLFSTR(">>> The ""F"" cross reference use to run the report does not exist . <<<",80) D ASKCONT(0) Q "RTN","DGOTHFSM",193,0) ;only extract INACTIVE OTH patients within the user-specified date range "RTN","DGOTHFSM",194,0) ;this is to ensure for fast data extraction "RTN","DGOTHFSM",195,0) ;EXEMPTION (only do this process): If the user's starting date is February 20, 2020 but the OTH patient "RTN","DGOTHFSM",196,0) ; had previous information stored in File #33, go ahead and include that patient "RTN","DGOTHFSM",197,0) ;check if starting date is February 20, 2020 - if true, reset the starting date to the OTH legislation date to Jul 01, 2017 "RTN","DGOTHFSM",198,0) ;loop thru cross reference "F" to run report "RTN","DGOTHFSM",199,0) I DGSORT("DGBEG")=3200220 S DGSTDT=3170701 "RTN","DGOTHFSM",200,0) E S DGSTDT=DGSORT("DGBEG") "RTN","DGOTHFSM",201,0) S DGOTHELDT=$$FMADD^XLFDT(DGSTDT,-1) "RTN","DGOTHFSM",202,0) F S DGOTHELDT=$O(^DGOTH(33,"F",DGOTHELDT)) Q:DGOTHELDT=""!((DGOTHELDT\1)>DGSORT("DGEND")) D "RTN","DGOTHFSM",203,0) . K DGERR,DGOTHARR,DGOTHREGDT,DGREGDT,DGIEN33 "RTN","DGOTHFSM",204,0) . S DGIEN33=+$O(^DGOTH(33,"F",DGOTHELDT,"")) "RTN","DGOTHFSM",205,0) . ;find only those INACTIVE OTH patients whose registration date falls within the user-specified date range "RTN","DGOTHFSM",206,0) . ;either these patients received adjudication or the PE is entered in error "RTN","DGOTHFSM",207,0) . D GETS^DIQ(33,DGIEN33_",",".01;.02;2*","IE","DGOTHARR","DGERR") "RTN","DGOTHFSM",208,0) . Q:$D(DGERR) "RTN","DGOTHFSM",209,0) . ;quit if status is ACTIVE "RTN","DGOTHFSM",210,0) . Q:$G(DGOTHARR(33,DGIEN33_",",.02,"I")) "RTN","DGOTHFSM",211,0) . ;loop through all the OTH Registration Date and determine the original "RTN","DGOTHFSM",212,0) . ;date the former OTH service member become EXPANDED MH CARE NON-ENROLLEE "RTN","DGOTHFSM",213,0) . S (DGFOUND,DGTOTREC)=0 "RTN","DGOTHFSM",214,0) . S DGTOTREC=$P(^DGOTH(33,DGIEN33,2,0),U,4) "RTN","DGOTHFSM",215,0) . Q:+DGTOTREC<1 "RTN","DGOTHFSM",216,0) . F II=1:1:DGTOTREC S DGREGDT(II)="" "RTN","DGOTHFSM",217,0) . S DGRECNUM="" F S DGRECNUM=$O(DGREGDT(DGRECNUM)) Q:DGRECNUM=""!(DGFOUND) D "RTN","DGOTHFSM",218,0) . . ;check if the eligibility is EXPANDED MH CARE NON-ENROLLEE "RTN","DGOTHFSM",219,0) . . I DGOTHARR(33.02,DGRECNUM_","_DGIEN33_",",.02,"E")="EXPANDED MH CARE NON-ENROLLEE" D "RTN","DGOTHFSM",220,0) . . . ;the original OTH registration date "RTN","DGOTHFSM",221,0) . . . S DGOTHREGDT=$G(DGOTHARR(33.02,DGRECNUM_","_DGIEN33_",",.01,"I")) "RTN","DGOTHFSM",222,0) . . . S DGDFN=$G(DGOTHARR(33,DGIEN33_",",.01,"I")) "RTN","DGOTHFSM",223,0) . . . S @DGOTHIN@(DGDFN,+DGIEN33)=DGOTHREGDT\1 "RTN","DGOTHFSM",224,0) . . . S DGFOUND=1 "RTN","DGOTHFSM",225,0) Q "RTN","DGOTHFSM",226,0) ; "RTN","DGOTHFSM",227,0) SCPRCT(DFN,DATA) ;extract the service connected percentage "RTN","DGOTHFSM",228,0) ; "RTN","DGOTHFSM",229,0) N VAEL,VADM,DGDOB "RTN","DGOTHFSM",230,0) D 2^VADPT ;extract patients demographics and eligibility information "RTN","DGOTHFSM",231,0) S DGDOB=$P(VADM(3),U) "RTN","DGOTHFSM",232,0) S DATA=DATA_U_$P(VAEL(3),"^",2)_U_DGDOB_U "RTN","DGOTHFSM",233,0) D KVAR^VADPT "RTN","DGOTHFSM",234,0) Q DATA "RTN","DGOTHFSM",235,0) ; "RTN","DGOTHFSM",236,0) CHKINT(DGENCTR,DATA) ; check for integrated site divisions "RTN","DGOTHFSM",237,0) ; "RTN","DGOTHFSM",238,0) N INTFCLTY,DGDIV,DGSTATN,OLDSTA,DGENCTRDT "RTN","DGOTHFSM",239,0) S OLDSTA="" "RTN","DGOTHFSM",240,0) S INTFCLTY="^528^589^636^657^" ; list of integrated site parent facilities (station #s) "RTN","DGOTHFSM",241,0) S DGDIV="" F S DGDIV=$O(DGENCTR(DGDIV)) Q:DGDIV="" D "RTN","DGOTHFSM",242,0) . S DGENCTRDT="" F S DGENCTRDT=$O(DGENCTR(DGDIV,DGENCTRDT)) Q:DGENCTRDT="" D "RTN","DGOTHFSM",243,0) . . S DGSTATN=$P(DGENCTR(DGDIV,DGENCTRDT),U,2) "RTN","DGOTHFSM",244,0) . . Q:DGSTATN="" "RTN","DGOTHFSM",245,0) . . ;only extract station id belong to the facility/division where the report is run "RTN","DGOTHFSM",246,0) . . Q:+DGSTATN'=+$P(HERE,U,3) "RTN","DGOTHFSM",247,0) . . I INTFCLTY[(U_+DGSTATN_U) D Q "RTN","DGOTHFSM",248,0) . . . ;if integrated facility, display all station id patient was treated "RTN","DGOTHFSM",249,0) . . . S @DGLIST@(DGPTNAME,DGDFN,DGSTATN)=DATA "RTN","DGOTHFSM",250,0) . . ;roll up the station to its site parent facilities "RTN","DGOTHFSM",251,0) . . ;e.g. 442,442GA,442GC - this will roll up to 442 "RTN","DGOTHFSM",252,0) . . I OLDSTA'=+DGSTATN S @DGLIST@(DGPTNAME,DGDFN,+DGSTATN)=DATA "RTN","DGOTHFSM",253,0) . . S OLDSTA=+DGSTATN "RTN","DGOTHFSM",254,0) Q "RTN","DGOTHFSM",255,0) ; "RTN","DGOTHFSM",256,0) PRINT(DGSORT,DGLIST) ;output report "RTN","DGOTHFSM",257,0) N DGPAGE,DDASH,DGQ,DGDFN,DGTOTAL,DGPRINT,DGOLD "RTN","DGOTHFSM",258,0) S (DGQ,DGTOTAL,DGPAGE,DGPRINT,DGOLD)=0,$P(DDASH,"=",81)="" "RTN","DGOTHFSM",259,0) I $O(@DGLIST@(""))="" D Q "RTN","DGOTHFSM",260,0) . D HEADER,COLHEAD "RTN","DGOTHFSM",261,0) . W !!!," >>> No records were found using the report criteria.",!! "RTN","DGOTHFSM",262,0) . W ! D LINE "RTN","DGOTHFSM",263,0) . D ASKCONT(0) "RTN","DGOTHFSM",264,0) ; loop and print report "RTN","DGOTHFSM",265,0) D HEADER,COLHEAD "RTN","DGOTHFSM",266,0) S DGPTNAME="" F S DGPTNAME=$O(@DGLIST@(DGPTNAME)) Q:DGPTNAME="" D Q:DGQ "RTN","DGOTHFSM",267,0) . I DGOLD'=DGPTNAME S DGPRINT=0 "RTN","DGOTHFSM",268,0) . S DGDFN="" F S DGDFN=$O(@DGLIST@(DGPTNAME,DGDFN)) Q:DGDFN="" D Q:DGQ "RTN","DGOTHFSM",269,0) . . S DGSTATN="" F S DGSTATN=$O(@DGLIST@(DGPTNAME,DGDFN,DGSTATN)) Q:DGSTATN="" D Q:DGQ "RTN","DGOTHFSM",270,0) . . . I $Y>(IOSL-4) W ! D LINE D PAUSE(.DGQ) Q:DGQ D HEADER,COLHEAD "RTN","DGOTHFSM",271,0) . . . W ! "RTN","DGOTHFSM",272,0) . . . I 'DGPRINT D PRINT1 S DGPRINT=1 "RTN","DGOTHFSM",273,0) . . . W ?54,$$FMTE^XLFDT($P(@DGLIST@(DGPTNAME,DGDFN,DGSTATN),U,3),"5Z") ;OTH registration date "RTN","DGOTHFSM",274,0) . . . W ?69,$P(@DGLIST@(DGPTNAME,DGDFN,DGSTATN),U,4) ;new primary eligibility code "RTN","DGOTHFSM",275,0) . . . W ?103,$P(@DGLIST@(DGPTNAME,DGDFN,DGSTATN),U,6) ;SC% "RTN","DGOTHFSM",276,0) . . . W ?110,$$FMTE^XLFDT($P(@DGLIST@(DGPTNAME,DGDFN,DGSTATN),U,5),"5Z") ;primary eligibility changed date "RTN","DGOTHFSM",277,0) . . . W ?125,DGSTATN "RTN","DGOTHFSM",278,0) . . . Q:DGQ "RTN","DGOTHFSM",279,0) . . Q:DGQ "RTN","DGOTHFSM",280,0) . S DGTOTAL=DGTOTAL+1 "RTN","DGOTHFSM",281,0) . Q:DGQ "RTN","DGOTHFSM",282,0) . S DGOLD=DGPTNAME "RTN","DGOTHFSM",283,0) Q:DGQ "RTN","DGOTHFSM",284,0) W ! "RTN","DGOTHFSM",285,0) D LINE "RTN","DGOTHFSM",286,0) W !!,"Number of Unique Patients: ",$J(DGTOTAL,5) "RTN","DGOTHFSM",287,0) W !!,"<< end of report >>" "RTN","DGOTHFSM",288,0) D ASKCONT(0) W @IOF "RTN","DGOTHFSM",289,0) Q "RTN","DGOTHFSM",290,0) ; "RTN","DGOTHFSM",291,0) PRINT1 ;print the name, pid, and DOB only once "RTN","DGOTHFSM",292,0) W $E($P(@DGLIST@(DGPTNAME,DGDFN,DGSTATN),U,1),1,30) ;patient name "RTN","DGOTHFSM",293,0) W ?33,$$FMTE^XLFDT($P(@DGLIST@(DGPTNAME,DGDFN,DGSTATN),U,7),"5Z") ;DOB "RTN","DGOTHFSM",294,0) W ?46,$P(@DGLIST@(DGPTNAME,DGDFN,DGSTATN),U,2) ;PID "RTN","DGOTHFSM",295,0) Q "RTN","DGOTHFSM",296,0) ; "RTN","DGOTHFSM",297,0) HEADER ;Display header for the report "RTN","DGOTHFSM",298,0) ; "RTN","DGOTHFSM",299,0) I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q "RTN","DGOTHFSM",300,0) I TRM!('TRM&DGPAGE) W @IOF "RTN","DGOTHFSM",301,0) S DGPAGE=$G(DGPAGE)+1 "RTN","DGOTHFSM",302,0) W !,?44,$G(ZTDESC),?120,"Page: ",?127,DGPAGE "RTN","DGOTHFSM",303,0) W ! D LINE "RTN","DGOTHFSM",304,0) W !,"OTH Eligibility Change Date Range: ",?12,$$FMTE^XLFDT(DGSORT("DGBEG"),"5Z")_" TO "_$$FMTE^XLFDT(DGSORT("DGEND"),"5Z") "RTN","DGOTHFSM",305,0) W ?92,"Date Printed : ",$$FMTE^XLFDT($$NOW^XLFDT,"MP") "RTN","DGOTHFSM",306,0) W !!,"List of Patients whose primary eligibility changed from EXPANDED MH CARE NON-ENROLLEE to a new primary eligibility code with" "RTN","DGOTHFSM",307,0) W !,"eligibility status of VERIFIED and have an Outpatient Encounter with the status of CHECKED OUT." "RTN","DGOTHFSM",308,0) W !!,"The Station ID column provides data on which site(s) the patient was treated." "RTN","DGOTHFSM",309,0) W ! D LINE "RTN","DGOTHFSM",310,0) Q "RTN","DGOTHFSM",311,0) ; "RTN","DGOTHFSM",312,0) LINE ;prints double dash line "RTN","DGOTHFSM",313,0) N LINE "RTN","DGOTHFSM",314,0) F LINE=1:1:132 W "=" "RTN","DGOTHFSM",315,0) Q "RTN","DGOTHFSM",316,0) ; "RTN","DGOTHFSM",317,0) COLHEAD ;report column header "RTN","DGOTHFSM",318,0) W "PATIENT NAME",?33,"DATE OF",?46,"PID",?54,"OTH REG DATE",?69,"NEW ELIGIBILITY CODE",?103,"SC%",?110,"ELIGIBILITY",?125,"STATION" "RTN","DGOTHFSM",319,0) W !,?33,"BIRTH",?110,"CHANGE DATE",?125,"ID" "RTN","DGOTHFSM",320,0) W !,"------------------------------",?33,"----------",?46,"-----",?54,"------------" "RTN","DGOTHFSM",321,0) W ?69,"------------------------------",?103,"----",?110,"-----------",?125,"-------" "RTN","DGOTHFSM",322,0) Q "RTN","DGOTHFSM",323,0) ; "RTN","DGOTHFSM",324,0) ASKCONT(FLAG) ; display "press to continue" prompt "RTN","DGOTHFSM",325,0) N Z "RTN","DGOTHFSM",326,0) W !!,$$CJ^XLFSTR("Press to "_$S(FLAG=1:"continue.",1:"exit."),20) "RTN","DGOTHFSM",327,0) R !,Z:DTIME "RTN","DGOTHFSM",328,0) Q "RTN","DGOTHFSM",329,0) ; "RTN","DGOTHFSM",330,0) CHKDATE(DATE,DGSORT) ;check if dates fall within the Begin and End dates "RTN","DGOTHFSM",331,0) Q DGSORT("DGBEG")<=DATE&(DGSORT("DGEND")>=DATE) "RTN","DGOTHFSM",332,0) ; "RTN","DGOTHFSM",333,0) PAUSE(DGQ) ; pause screen display "RTN","DGOTHFSM",334,0) ; Input: "RTN","DGOTHFSM",335,0) ; DGQ - var used to quit report processing to user CRT "RTN","DGOTHFSM",336,0) ; Output: "RTN","DGOTHFSM",337,0) ; DGQ - passed by reference - 0 = Continue, 1 = Quit "RTN","DGOTHFSM",338,0) ; "RTN","DGOTHFSM",339,0) I $G(DGPAGE)>0,TRM K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQ=1 "RTN","DGOTHFSM",340,0) Q "RTN","DGOTHFSM",341,0) ; "RTN","DGOTHFSM",342,0) EXIT ; "RTN","DGOTHFSM",343,0) I $D(ZTQUEUED) S ZTREQ="@" ;tell TaskMan to delete Task log entry "RTN","DGOTHFSM",344,0) I '$D(ZTQUEUED) D "RTN","DGOTHFSM",345,0) . I 'TRM,$Y>0 W @IOF "RTN","DGOTHFSM",346,0) . K %ZIS,POP "RTN","DGOTHFSM",347,0) . D ^%ZISC,HOME^%ZIS "RTN","DGOTHFSM",348,0) Q "RTN","DGOTHFSM",349,0) ; "UP",33,33.02,-1) 33^2 "UP",33,33.02,0) 33.02 "VER") 8.0^22.2 "^DD",33,33,2,0) ELIGIBILITY CHANGES^33.02DA^^2;0 "^DD",33,33,2,21,0) ^.001^1^1^3190618^^^^ "^DD",33,33,2,21,1,0) This multiple contains history of OTH eligibility changes. "^DD",33,33.02,0) ELIGIBILITY CHANGES SUB-FIELD^^.06^7 "^DD",33,33.02,0,"NM","ELIGIBILITY CHANGES") "^DD",33,33.02,.01,0) ELIGIBILITY CHANGE DATE/TIME^D^^0;1^S %DT="ESTXR" D ^%DT S X=Y K:X<1 X "^DD",33,33.02,.01,1,0) ^.1 "^DD",33,33.02,.01,1,1,0) 33.02^B "^DD",33,33.02,.01,1,1,1) S ^DGOTH(33,DA(1),2,"B",$E(X,1,30),DA)="" "^DD",33,33.02,.01,1,1,2) K ^DGOTH(33,DA(1),2,"B",$E(X,1,30),DA) "^DD",33,33.02,.01,3) Enter the date of this eligibility change. "^DD",33,33.02,.01,21,0) ^^1^1^3190307^ "^DD",33,33.02,.01,21,1,0) Date of the eligibility change. "^DD",33,33.02,.01,"DT") 3200813 **INSTALL NAME** IB*2.0*685 "BLD",11118,0) IB*2.0*685^INTEGRATED BILLING^0^3201118^y "BLD",11118,1,0) ^^13^13^3200908^^^ "BLD",11118,1,1,0) IB*2.0*685 (Integrated Billing) is bundled with DG*5.3*1025 "BLD",11118,1,2,0) (Registration) in host file. "BLD",11118,1,3,0) "BLD",11118,1,4,0) The SHRPE product makes enhancements to the Registration (patch "BLD",11118,1,5,0) DG*5.3*1025) to implement reports that would help Registration and Billing "BLD",11118,1,6,0) users to identify patients that were treated under Other Than Honorable "BLD",11118,1,7,0) authority and provide details about eligibility changes and VA care "BLD",11118,1,8,0) provided to these patients. The reports are developed in DG namespace but "BLD",11118,1,9,0) need to be available to both Registration and Integrated billing users. "BLD",11118,1,10,0) "BLD",11118,1,11,0) The billing users of the [IB OUTPUT PATIENT REPORT MENU] menu need access "BLD",11118,1,12,0) to REGISTRATION menu options [DG OTH FSM ELIG. CHANGE REPORT] and [DG OTH "BLD",11118,1,13,0) FSM DETAIL REPORT] from patch DG*5.3*1025. "BLD",11118,4,0) ^9.64PA^^ "BLD",11118,6) 3 "BLD",11118,6.3) 8 "BLD",11118,"ABPKG") n "BLD",11118,"KRN",0) ^9.67PA^1.5^25 "BLD",11118,"KRN",.4,0) .4 "BLD",11118,"KRN",.401,0) .401 "BLD",11118,"KRN",.402,0) .402 "BLD",11118,"KRN",.403,0) .403 "BLD",11118,"KRN",.5,0) .5 "BLD",11118,"KRN",.84,0) .84 "BLD",11118,"KRN",1.5,0) 1.5 "BLD",11118,"KRN",1.6,0) 1.6 "BLD",11118,"KRN",1.61,0) 1.61 "BLD",11118,"KRN",1.62,0) 1.62 "BLD",11118,"KRN",3.6,0) 3.6 "BLD",11118,"KRN",3.8,0) 3.8 "BLD",11118,"KRN",9.2,0) 9.2 "BLD",11118,"KRN",9.8,0) 9.8 "BLD",11118,"KRN",19,0) 19 "BLD",11118,"KRN",19,"NM",0) ^9.68A^3^3 "BLD",11118,"KRN",19,"NM",1,0) DG OTH FSM DETAIL REPORT^^0 "BLD",11118,"KRN",19,"NM",2,0) DG OTH FSM ELIG. CHANGE REPORT^^0 "BLD",11118,"KRN",19,"NM",3,0) IB OUTPUT PATIENT REPORT MENU^^2 "BLD",11118,"KRN",19,"NM","B","DG OTH FSM DETAIL REPORT",1) "BLD",11118,"KRN",19,"NM","B","DG OTH FSM ELIG. CHANGE REPORT",2) "BLD",11118,"KRN",19,"NM","B","IB OUTPUT PATIENT REPORT MENU",3) "BLD",11118,"KRN",19.1,0) 19.1 "BLD",11118,"KRN",101,0) 101 "BLD",11118,"KRN",409.61,0) 409.61 "BLD",11118,"KRN",771,0) 771 "BLD",11118,"KRN",779.2,0) 779.2 "BLD",11118,"KRN",870,0) 870 "BLD",11118,"KRN",8989.51,0) 8989.51 "BLD",11118,"KRN",8989.52,0) 8989.52 "BLD",11118,"KRN",8993,0) 8993 "BLD",11118,"KRN",8994,0) 8994 "BLD",11118,"KRN","B",.4,.4) "BLD",11118,"KRN","B",.401,.401) "BLD",11118,"KRN","B",.402,.402) "BLD",11118,"KRN","B",.403,.403) "BLD",11118,"KRN","B",.5,.5) "BLD",11118,"KRN","B",.84,.84) "BLD",11118,"KRN","B",1.5,1.5) "BLD",11118,"KRN","B",1.6,1.6) "BLD",11118,"KRN","B",1.61,1.61) "BLD",11118,"KRN","B",1.62,1.62) "BLD",11118,"KRN","B",3.6,3.6) "BLD",11118,"KRN","B",3.8,3.8) "BLD",11118,"KRN","B",9.2,9.2) "BLD",11118,"KRN","B",9.8,9.8) "BLD",11118,"KRN","B",19,19) "BLD",11118,"KRN","B",19.1,19.1) "BLD",11118,"KRN","B",101,101) "BLD",11118,"KRN","B",409.61,409.61) "BLD",11118,"KRN","B",771,771) "BLD",11118,"KRN","B",779.2,779.2) "BLD",11118,"KRN","B",870,870) "BLD",11118,"KRN","B",8989.51,8989.51) "BLD",11118,"KRN","B",8989.52,8989.52) "BLD",11118,"KRN","B",8993,8993) "BLD",11118,"KRN","B",8994,8994) "BLD",11118,"QDEF") ^^^^NO^^^^YES^^NO "BLD",11118,"QUES",0) ^9.62^^ "BLD",11118,"REQB",0) ^9.611^1^1 "BLD",11118,"REQB",1,0) DG*5.3*1025^2 "BLD",11118,"REQB","B","DG*5.3*1025",1) "KRN",19,6207,-1) 2^3 "KRN",19,6207,0) IB OUTPUT PATIENT REPORT MENU^Patient Billing Reports Menu^^M^1^^^^^^^192 "KRN",19,6207,10,0) ^19.01PI^35^35 "KRN",19,6207,10,34,0) 14843^OTHL "KRN",19,6207,10,34,"^") DG OTH FSM ELIG. CHANGE REPORT "KRN",19,6207,10,35,0) 14846^OTHD "KRN",19,6207,10,35,"^") DG OTH FSM DETAIL REPORT "KRN",19,6207,"U") PATIENT BILLING REPORTS MENU "KRN",19,14843,-1) 0^2 "KRN",19,14843,0) DG OTH FSM ELIG. CHANGE REPORT^Former OTH Patient Eligibility Change Report^^R^^^^^^^^ "KRN",19,14843,1,0) ^19.06^5^5^3200713^^^ "KRN",19,14843,1,1,0) Assist users in reviewing past encounters of Former Service Member for "KRN",19,14843,1,2,0) potential back-billing charges. This report provides data for all Former "KRN",19,14843,1,3,0) OTH Service Member whose primary eligibility changed from EXPANDED MH "KRN",19,14843,1,4,0) CARE NON-ENROLLEE to their verified/determined (VBA) primary eligibility "KRN",19,14843,1,5,0) within a user specified date range. "KRN",19,14843,25) MAIN^DGOTHFSM "KRN",19,14843,"U") FORMER OTH PATIENT ELIGIBILITY "KRN",19,14846,-1) 0^1 "KRN",19,14846,0) DG OTH FSM DETAIL REPORT^Former OTH Patient Detail Report^^R^^^^^^^^ "KRN",19,14846,1,0) ^^3^3^3200805^ "KRN",19,14846,1,1,0) This option assist users in reviewing Former Service Members for "KRN",19,14846,1,2,0) potential back-billing charges so veteran customer will be billed "KRN",19,14846,1,3,0) appropriately. "KRN",19,14846,25) MAIN^DGOTHFS2 "KRN",19,14846,"U") FORMER OTH PATIENT DETAIL REPO "MBREQ") 0 "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",192,-1) 1^1 "PKG",192,0) INTEGRATED BILLING^IB^INTEGRATED BILLING "PKG",192,22,0) ^9.49I^1^1 "PKG",192,22,1,0) 2.0^2940321^2940414 "PKG",192,22,1,"PAH",1,0) 685^3201118^520824665 "PKG",192,22,1,"PAH",1,1,0) ^^13^13^3201118 "PKG",192,22,1,"PAH",1,1,1,0) IB*2.0*685 (Integrated Billing) is bundled with DG*5.3*1025 "PKG",192,22,1,"PAH",1,1,2,0) (Registration) in host file. "PKG",192,22,1,"PAH",1,1,3,0) "PKG",192,22,1,"PAH",1,1,4,0) The SHRPE product makes enhancements to the Registration (patch "PKG",192,22,1,"PAH",1,1,5,0) DG*5.3*1025) to implement reports that would help Registration and Billing "PKG",192,22,1,"PAH",1,1,6,0) users to identify patients that were treated under Other Than Honorable "PKG",192,22,1,"PAH",1,1,7,0) authority and provide details about eligibility changes and VA care "PKG",192,22,1,"PAH",1,1,8,0) provided to these patients. The reports are developed in DG namespace but "PKG",192,22,1,"PAH",1,1,9,0) need to be available to both Registration and Integrated billing users. "PKG",192,22,1,"PAH",1,1,10,0) "PKG",192,22,1,"PAH",1,1,11,0) The billing users of the [IB OUTPUT PATIENT REPORT MENU] menu need access "PKG",192,22,1,"PAH",1,1,12,0) to REGISTRATION menu options [DG OTH FSM ELIG. CHANGE REPORT] and [DG OTH "PKG",192,22,1,"PAH",1,1,13,0) FSM DETAIL REPORT] from patch DG*5.3*1025. "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") YES "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 "VER") 8.0^22.2 **END** **END**