- DGOTHFS2 ;SLC/RM - FORMER OTH PATIENT DETAIL REPORT 2 ; July 30,2020@09:44am
- ;;5.3;Registration;**1025,1034,1035**;Aug 13, 1993;Build 14
- ;
- ;Global References Supported by ICR# Type
- ;----------------- ----------------- ---------
- ; ^DG(391 2966 (DG is the Custodial Package) Cont. Sub.
- ; ^DIC(31 733 Cont. Sub.
- ; ^TMP($J SACC 2.3.2.5.1
- ;
- ;External References
- ;-------------------
- ; HOME^%ZIS 10086 Supported
- ; $$FINDCUR^DGENA 3812 (DG is the Custodial Package) Cont. Sub.
- ; DISP^DGIBDSP 4408 (DG is the Custodial Package) Cont. Sub.
- ; $$MTS^DGMTU 642 (DG is the Custodial Package) Cont. Sub.
- ; DIS^DGMTU 3789 (DG is the Custodial Package) Cont. Sub.
- ; $$RDIS^DGRPDB 4807 Supported
- ; ^DIC 10006 Supported
- ; WAIT^DICD 10024 Supported
- ; RECALL^DILFD 2055 Supported
- ; $$GET1^DIQ 2056 Supported
- ; $$GET1^DIQ(27.11 4947 (DG is the Custodial Package) Private
- ; ^DIR 10026 Supported
- ; $$INSUR^IBBAPI 4419 Supported
- ; EN^IBEFSMUT 7202 DG has permission to access) Private
- ; RX^PSO52API 4820 Supported
- ; 2^VADPT 10061 Supported
- ; KVAR^VADPT 10061 Supported
- ; $$SITE^VASITE 10112 Supported
- ; $$FMTE^XLFDT 10103 Supported
- ; $$CJ^XLFSTR 10104 Supported
- ; EN^XUTMDEVQ 1519 Supported
- ;
- ;No direct call
- Q
- ;
- ;Entry point for DG FORMER OTH PATIENTS DETAIL REPORT option
- MAIN ; Initial Interactive Processing
- N DGSORT,IBOTHSTAT ;array of report parameters
- N ZTDESC,ZTQUEUED,ZTREQ,ZTSAVE,ZTSTOP,DGPTNM,DGMTS,VAUTD,%ZIS,DGENCNT,SORTENCBY,DGRTNSTCK,DGPRTLRXFL
- N INACTIVE,DGDFN,DFN,VAEL,VADM,VA,I3,DGPID,DGPAGE,DGRPTSRT,DGTOTALRX,IBOTHSTAT,DGTOTRX52
- N RECORD ;temp data storage for all records found in file #409.68,and #405 sorted by date of service
- N RECORD1 ;temp data storage for all records found in file #409.68,and #405 sorted by division
- ;check for database
- I '+$O(^DGOTH(33,"B","")) W !!!,$$CJ^XLFSTR(">>> No OTH records have been found. <<<",80) D ASKCONT^DGOTHFSM(0) Q
- W @IOF
- S (INACTIVE,DGRPTSRT,DGRTNSTCK,DGPRTLRXFL)=0,SORTENCBY=2
- W "FORMER OTH PATIENT DETAIL REPORT",!!
- W "This option assists billing user in reviewing Former Service Member's past"
- W !,"episodes of care and released prescription details to determine if"
- W !,"potential back-billing is necessary."
- W !!,"*** THIS REPORT REQUIRES 132 COLUMN OUTPUT TO PRINT CORRECTLY ***"
- W !!,"At the DEVICE: prompt, please accept the default value of '0;132;'"
- W !,"This is to deliberately avoid undesired wrapping problems of the data.",!!
- ;prompt user to enter patient
- D PROMPTPT
- Q:'INACTIVE!(DGSORT'>0)
- D RECALL^DILFD(33,+DGSORT_",",DUZ)
- ;Prompt user what type of data/report user wish to see
- ;user had two options: Eligibility or Encounters
- I '$$RPTTYPE Q
- S RECORD=$NA(^TMP($J,"DGOTHFSDOS"))
- S RECORD1=$NA(^TMP($J,"DGOTHFSDIV"))
- S IBOTHSTAT=$NA(^TMP($J,"IBOTHSTAT"))
- K @RECORD ;temp data storage for all records found in file #409.68,and #405 sorted by date of service
- K @RECORD1 ;temp data storage for all records found in file #409.68,and #405 sorted by division
- K ^TMP($J,"OTHFSMR2") ;patient's RX information from File #52
- K ^TMP($J,"OTHFSMRX") ;temporary storage for all Rx information and IB status ready for printing report
- K @IBOTHSTAT ;temp storage for file #350 and file # 399 IB status
- ;if user select report type ALL, prompt user how it will be sorted
- ;do not continue, if user does not select any sorting
- I DGSORT("RTYPE")="A" D Q:DGRPTSRT<1
- . ;determine first the original date the former OTH service member become EXPANDED
- . ;MH CARE NON-ENROLLEE and loop through all the OTH Registration Date
- . S DGIEN33=DGSORT,(DGENCNT,DGTOTALRX,DGTOTRX52,DGRTNSTCK,DGPRTLRXFL)=0
- . S DGSORT("DGBEG")=$$OTHREGDT(DGIEN33) ;the date when the patient became OTH
- . S DGSORT("DGEND")=$$GET1^DIQ(2,DGDFN_",",.3612,"I") ;the date when the PE eligibility status of patient became VERIFIED
- . S VAUTD=1 ;All the divisions in the facility, since we are not prompting user to enter Division
- . D CHKTREAT^DGFSMOUT(DGDFN,DGSORT("DGBEG"),DGSORT("DGEND"),.VAUTD,0) ;check if there any past Outpatient Encounter entry (file #409.68) for this patient
- . D CHECKPTF^DGFSMOUT(DGDFN,DGSORT("DGBEG"),DGSORT("DGEND"),"IBOTHSTAT") ;check if there any Inpatient stay entry in file #405
- . D CHECKIB^DGFSMOUT("IBOTHSTAT",DGSORT("DGBEG"),DGSORT("DGEND")) ;check if this patient has records in file #350 or file #399
- . D RX^PSO52API(DGDFN,"OTHFSMR2",,,"2,R,P",DGSORT("DGBEG"),$$FMADD^XLFDT(DGSORT("DGEND"),366)) ;get the medication profile of a patient from PRESCRIPTION file (#52)
- . ;before moving forward remove RX data from the patient's episode of care array first
- . I $O(@RECORD@(""))'="" D FLTRENC^DGOTHFS4 ;determines whether to prompt Encounter sorting
- . I DGTOTALRX<2 S DGTOTRX52=+$P(^TMP($J,"OTHFSMR2",DGDFN,0),U) I +DGTOTRX52>0 D TOTRX^DGOTHFS4 ;determines whether to prompt the Rx sorting and see if the Rx released date is within the date range
- . S DGTOTALRX=DGTOTALRX+DGTOTRX52
- . I $O(@IBOTHSTAT@(""))="" D EN^IBEFSMUT(DGDFN,DGSORT("DGBEG"),DGSORT("DGEND"),"IBOTHSTAT") ;extract in advance the IB STATUS in both file #350 and file #399
- . I (DGENCNT>1),(DGTOTALRX>1) D Q
- . . W !!,"Please select sorting order for Episodes of Care and Released Prescription",!,"report section:"
- . . ;prompt user how the Encounter report section will be sorted
- . . I '$$SORTENC^DGOTHFS3 Q
- . . ;prompt user Rx report section will be sorted
- . . I '$$SORTRX^DGOTHFS3 Q
- . . S DGRPTSRT=1
- . I (DGENCNT>1),(DGTOTALRX<2) D Q
- . . W !!,"Please select sorting order for Episodes of Care report section:"
- . . I '$$SORTENC^DGOTHFS3 Q
- . . S DGRPTSRT=1,DGSORT("SORTRXBY")=1
- . I (DGENCNT<2),(DGTOTALRX>1) D Q
- . . W !!,"Please select sorting order for Released Prescription report section:"
- . . I '$$SORTRX^DGOTHFS3 Q
- . . S DGRPTSRT=1
- . . S DGSORT("SORTENCBY")=1
- . S DGSORT("SORTENCBY")=1,DGSORT("SORTRXBY")=1
- . S DGRPTSRT=1
- W !!
- S %ZIS=""
- S %ZIS("B")="0;132;"
- S ZTSAVE("DGSORT(")=""
- S ZTSAVE("DGSORT")=""
- S ZTSAVE("DGDFN")=""
- S ZTSAVE("DGPTNM")=""
- S ZTSAVE("DGTOTALRX")=""
- S X="FORMER OTH PATIENT ELIGIBILITY CHANGE REPORT"
- D EN^XUTMDEVQ("START^DGOTHFS2",X,.ZTSAVE,.%ZIS)
- D HOME^%ZIS
- Q
- ;
- START ;starting point to generate report
- I $E(IOST)="C" D WAIT^DICD
- N HERE S HERE=$$SITE^VASITE ;extract the IEN and facility name where the report is run
- N TRM S TRM=($E(IOST)="C")
- S (DGQ,DGPAGE,I3)=0
- S DGIEN33=DGSORT
- S DFN=DGDFN
- S DGPID=$$GET1^DIQ(2,DFN_",",.0905,"I")
- ;display the patient's current and verified eligibility
- D CURRENT(DGDFN,DGPTNM)
- W !
- ;display patient's Means Test Status information
- D MTS(DGDFN)
- ;display patient's Rated Disabilities information
- D RTDDIS(DGDFN)
- Q:DGQ
- ;display patient's Insurance information
- D INS(DGDFN)
- Q:DGQ
- ;display patient's all Primary Eligibility history
- D HISTORY(DGIEN33)
- Q:DGQ
- ;if user wants to see patient Encounter and Rx information
- I DGSORT("RTYPE")="A" D
- . ;display patient's checked out Encounters and inpatient data
- . D ENCTR(DGDFN,.DGSORT)
- . Q:DGQ
- . ;display patient's Released Prescriptions
- . D RX(DGDFN,.DGSORT)
- D KVAR^VADPT
- K @RECORD,@RECORD1,@IBOTHSTAT,^TMP($J,"OTHFSMR2"),^TMP($J,"OTHFSMRX")
- D EXIT^DGOTHFSM
- Q
- ;
- PROMPTPT ;prompt user to enter patient
- ;keep prompting for patient name until user enter patient with INACTIVE status
- F D Q:INACTIVE
- . ;Prompt user for OTH patient name
- . S DGPTNM=$$SELPAT(.DGSORT)
- . I DGSORT'>0 S INACTIVE=1 Q
- . I $$ACTIVE(.DGSORT) D Q
- . . W !!,"The patient you selected is still PENDING for VBA Adjudication."
- . . D RUNOPT
- . ;if INACTIVE STATUS, check if the eligibility status is VERIFIED
- . S DGDFN=$P(DGSORT(0),U)
- . I $$GET1^DIQ(2,DGDFN_",",.3611,"I")'="V" D Q
- . . W !!,"The primary eligibility status of the patient you selected is not VERIFIED."
- . . D RUNOPT
- . S INACTIVE=1
- Q
- ;
- RUNOPT ;display message to run FORMER OTH PATIENT ELIGIBILITY CHANGE REPORT option
- W !,"Please run FORMER OTH PATIENT ELIGIBILITY CHANGE REPORT option"
- W !,"to identify Former OTH Service Member whose Primary Eligibility"
- W !,"changed from EXPANDED MH CARE NON-ENROLLEE to a new Primary"
- W !,"Eligibility with a VERIFIED eligibility status.",!
- Q
- ;
- ACTIVE(DGSORT) ;determine the current status of OTH patient
- ;return 0 for INACTIVE
- ;otherwise, 1 for ACTIVE
- N DGIEN33,DGOTHSTAT
- S DGIEN33=DGSORT
- S DGOTHSTAT=$$GET1^DIQ(33,DGIEN33_",",.02,"I")
- Q DGOTHSTAT
- ;
- SELPAT(DGSORT) ;prompt for veteran's name
- ;- input vars for ^DIC call
- N DIC,DTOUT,DUOUT,X,Y
- S DIC="^DGOTH(33,",DIC(0)="AEMQZV"
- S DIC("A")="Enter Patient Name: "
- S DIC("?PARAM",33,"INDEX")="B"
- S DIC("?N",33)=12
- ;- lookup patient
- D ^DIC K DIC
- ;- result of lookup
- S DGSORT=Y
- ;- if success, setup return array using output vars from ^DIC call
- I (+DGSORT>0) D Q Y(0,0) ;patient name
- . S DGSORT=+Y ;patient ien
- . S DGSORT(0)=$G(Y(0)) ;zero node of patient in (#2) file
- Q -1
- ;
- RPTTYPE() ;prompt for type of data user wish to see
- N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
- S DGDIRA="Select the type of report ('E'ligibility/'A'll): "
- S DGDIRB=""
- S DGDIRH="^D HELP^DGOTHFS2"
- S DGDIRO="SAO^E:Eligibility;A:All (Eligibility, Episodes of Care, Prescription)"
- S DGASK=$$ANSWER^DGOTHFSM(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
- I DGASK="E"!(DGASK="A") S DGSORT("RTYPE")=DGASK,DGASK=1
- E S DGASK=0
- Q DGASK
- ;
- CURRENT(DFN,PTNAME) ;display patient current and verified PE eligibility
- N I1,DGENR,DGENRIEN,DGENRPRI,DGENRGRP
- S (DGENRIEN,DGENRPRI,DGENRGRP)=""
- D 2^VADPT
- D PTHDR("FORMER OTH PATIENT DETAIL REPORT")
- D LINE(0)
- W !,"Current Eligibility Code : ",$P(VAEL(1),"^",2)," -- ",$S(VAEL(8)']"":"NOT VERIFIED",1:$P(VAEL(8),"^",2))
- W " ",$$FMTE^XLFDT($$GET1^DIQ(2,DGDFN_",",.3612,"I"),"5Z") ;PE eligibility changed date
- 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)
- E W "NO ADDITIONAL ELIGIBILITIES IDENTIFIED"
- S DGENRIEN=$$FINDCUR^DGENA(DFN)
- I DGENRIEN'="" S DGENRPRI=$$GET1^DIQ(27.11,DGENRIEN_",",.07,"E"),DGENRGRP=$$GET1^DIQ(27.11,DGENRIEN_",",.12,"E")
- W !,"Enrollment Priority : ",$S(DGENRIEN="":"NOT ENROLLED",((DGENRPRI="")&(DGENRGRP="")):"NONE STATED",1:DGENRPRI_DGENRGRP)
- W ! D LINE(1)
- Q
- ;
- MTS(DFN) ;display patient's Means Test Status information
- S DGMTS=$$MTS^DGMTU(DFN)
- I DGMTS="" W !,"Means Test Status : NOT IN MEANS TEST FILE"
- E D DIS^DGMTU(DFN)
- Q
- ;
- RTDDIS(DFN) ;display patient's rated disabilities information
- N DGPTYPE,DGC,DGARR
- W !!,"Service Connected : ",$S('+VAEL(3):"NO",1:"YES")
- W:+VAEL(3) ?33,"SC Percent : ",$P(VAEL(3),"^",2)_"%"
- 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
- I '$$RDIS^DGRPDB(DFN,.DGARR) W "NONE STATED" Q
- F DGC=0:0 S DGC=$O(DGARR(DGC)) Q:'DGC D Q:DGQ
- . S I3=I3+1
- . N DGP1,DGP2,DGP3,DGZERO
- . I $G(DGARR(DGC))']"" Q
- . S DGZERO=+DGARR(DGC)
- . I '$D(^DIC(31,DGZERO,0)) Q
- . S DGP1=$P(^DIC(31,DGZERO,0),U,3)
- . S DGP2=$P(^DIC(31,DGZERO,0),U)
- . 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")_")"
- . I $Y>(IOSL-4) W ! D PAUSE(.DGQ) Q:DGQ D PTHDR,LINE(0)
- . W:I3>1 !?20
- . W $G(DGP1)_" - ",$E(DGP2,1,30)," ",DGP3
- W:'I3 "NONE STATED"
- Q
- ;
- INS(DFN) ;display patient's health insurance information
- N Z,I,I1
- ;if patient had more than 6 rated disability, then display the insurance information in a separate page
- I I3>6 W !! D PAUSE(.DGQ) Q:DGQ D PTHDR,LINE(0)
- W !!,"Health Insurance : "
- S Z=$$INSUR^IBBAPI(DFN,DT)
- W $S(Z:"YES",1:"NO")
- D DISP^DGIBDSP
- K I,I1,Z
- I $G(DGMTS)="" W !
- Q
- ;
- HISTORY(IEN33) ;extract all eligibility history
- N DGELHIST,DGOTHIST,DGRECNUM,DGLINE,DGOTHTYP
- ;display this piece of information to its own page so that the report will not look cluttered
- D PAUSE(.DGQ) Q:DGQ D PTHDR,LINE(0) W !
- D HDR(0)
- W !
- K DGOTHIST
- S DGELHIST=$$CROSS^DGOTHINQ(IEN33,.DGOTHIST)
- ;go through all the eligibility history and only display date starting from Feb. 20,2020
- ;3200220 is the Release Date of EXPANDED MH CARE NON-ENROLLEE
- S DGRECNUM="" F S DGRECNUM=$O(DGOTHIST(IEN33,DGRECNUM)) Q:DGRECNUM="" D Q:DGQ
- . I $Y>(IOSL-4) W ! D PAUSE(.DGQ) Q:DGQ D PTHDR,LINE(0) W !! D HDR(1)
- . S DGLINE=DGOTHIST(IEN33,DGRECNUM)
- . S DGOTHTYP=$$OTHTYP^DGOTHINQ($P(DGLINE,U))
- . W $S($P(DGLINE,U)="":"UNKNOWN",+DGOTHTYP:"EXPANDED MH CARE NON-ENROLLEE"_" ("_$P(DGLINE,U)_")",1:$P(DGLINE,U))
- . I $P(DGLINE,U)="EXPANDED MH CARE NON-ENROLLEE" W " (N/A)"
- . W ?60,$$FMTE^XLFDT($P(DGLINE,U,2),"5Z")
- . W !
- ;break before going back to parent menu
- I DGSORT("RTYPE")="E" W !!,"<< end of report >>" D ASKCONT^DGOTHFSM(0) W @IOF
- Q
- ;
- OTHREGDT(DGIEN33) ;determine the original date the former OTH service member become EXPANDED MH CARE NON-ENROLLEE
- ;return the original OTH registration date
- N DGFOUND,DGTOTREC,DGRECNUM,DGOTHARR,DGOTHREGDT,DGERR,DGREGDT,II
- S (DGFOUND,DGTOTREC,DGOTHREGDT)=0
- S DGTOTREC=$P(^DGOTH(33,DGIEN33,2,0),U,4)
- Q:+DGTOTREC<1
- F II=1:1:DGTOTREC S DGREGDT(II)=""
- S DGRECNUM="" F S DGRECNUM=$O(DGREGDT(DGRECNUM)) Q:DGRECNUM=""!(DGFOUND) D
- . K DGOTHARR,DGERR
- . D GETS^DIQ(33,DGIEN33_",","2*","IE","DGOTHARR","DGERR")
- . Q:$D(DGERR)
- . ;check if the eligibility is EXPANDED MH CARE NON-ENROLLEE
- . I DGOTHARR(33.02,DGRECNUM_","_DGIEN33_",",.02,"E")="EXPANDED MH CARE NON-ENROLLEE" D
- . . ;the original OTH registration date
- . . S DGOTHREGDT=$G(DGOTHARR(33.02,DGRECNUM_","_DGIEN33_",",.01,"I"))
- . . S DGFOUND=1
- Q DGOTHREGDT\1
- ;
- ENCTR(DFN,DGSORT) ;display patient's episodes of care
- N DGDIV,DGENCTRDT,DGTOTENC,SUB1,SUB2,JJ,DGENCTRIB,FILENO,STAT350,STAT399,BILLNO,ACRTYP,CHRGCNT,PRINTRPT
- ;display this piece of information to its own page so that the report will not look cluttered
- D PAUSE(.DGQ) Q:DGQ D PTHDR,LINE(0)
- D ENCHDR(0),ENCTRCOL,LINE(1)
- S (DGTOTENC,PRINTRPT)=0
- I $O(@RECORD@(""))="" D
- . W !!,">> NO DATA FOUND FROM "_$$FMTE^XLFDT(DGSORT("DGBEG"),"5ZF")_" TO "_$$FMTE^XLFDT(DGSORT("DGEND"),"5ZF")_"."
- . W ! D LINE(1)
- . Q:DGQ
- . W !!,"Total Number of Encounter: ",DGTOTENC
- E D
- . I 'PRINTRPT D
- . . I $P(DGSORT("SORTENCBY"),U)=2 D
- . . . K @RECORD
- . . . M @RECORD=@RECORD1
- . . . K @RECORD1
- . . D ENCTRIB^DGOTHFS3 ;extract the IB status
- . . S PRINTRPT=1
- . D ENCTRIB^DGOTHFS3 ;use the same loop to display status
- Q
- ;
- ENCTRCOL ;display encounter column name
- W !,"Location of",?22,"Clinic Stop/",?45,"Primary",?55,"Div.",?61,"Date of",?72,"Last Updated",?89,"Bill #",?100,"Action Type/",?116,"IB Status"
- W !,"Care",?22,"Treating Specialty",?45,"DX",?61,"Service",?77,"By",?100,"Rate Type",!
- Q
- ;
- ENCHDR(FLAG) ;Encounter Header
- N TITLE
- S TITLE="PATIENT'S EPISODE OF CARE"_$S(FLAG:" - Continuation",1:"")
- W !,?132-$L(TITLE)\2,TITLE,!
- D DTRANGE
- S TITLE="Sorted By: "_$E($P(DGSORT("SORTENCBY"),U,2),4,20)
- I $P(DGSORT("SORTENCBY"),U,2)'="" W ?132-$L(TITLE)\2,TITLE,!
- D LINE(1)
- Q
- ;
- DTRANGE ;display date range
- N DTRANGE
- S DTRANGE="Date Range: "_$$FMTE^XLFDT(DGSORT("DGBEG"),"5ZF")_" - "_$$FMTE^XLFDT(DGSORT("DGEND"),"5ZF")
- W ?132-$L(DTRANGE)\2,DTRANGE,!
- Q
- ;
- RX(DFN,DGSORT) ;extract patient's released prescription
- N FILENO,OTHIBDT,OTHIBREC,ACCTYP,RESULT,CNTR,OTHIBRX
- ;display this piece of information to its own page so that the report will not look cluttered
- D PAUSE(.DGQ) Q:DGQ D PTHDR,LINE(0)
- ;traverse ^TMP($J,"IBOTHSTAT" if the dates listed exist
- ;in the ^TMP($J,"OTHFSMR2", this is where all the RX's of the patient
- ;is stored.
- S CNTR=0
- F FILENO=350,399 D Q:DGQ
- . Q:$P(^TMP($J,"IBOTHSTAT",FILENO,DFN,0),U)<1
- . S OTHIBDT="" F S OTHIBDT=$O(^TMP($J,"IBOTHSTAT",FILENO,OTHIBDT)) Q:OTHIBDT="" D Q:DGQ
- . . S OTHIBREC="" F S OTHIBREC=$O(^TMP($J,"IBOTHSTAT",FILENO,OTHIBDT,DFN,OTHIBREC)) Q:OTHIBREC="" D Q:DGQ
- . . . ;quit if not within the date range selected by the user
- . . . Q:'$$CHKDATE(OTHIBDT,.DGSORT)
- . . . I FILENO=350 D Q:ACCTYP'["RX"
- . . . . S ACCTYP=$P(^TMP($J,"IBOTHSTAT",FILENO,OTHIBDT,DFN,OTHIBREC),U)
- . . . I FILENO=399 D Q:$P(ACCTYP,U)'=3
- . . . . S ACCTYP=$P($P($P(^TMP($J,"IBOTHSTAT",FILENO,OTHIBDT,DFN,OTHIBREC),U,5),";"),":")
- . . . S RESULT=$P(^TMP($J,"IBOTHSTAT",FILENO,OTHIBDT,DFN,OTHIBREC),U,5)
- . . . I $P(RESULT,":")=52 S OTHIBRX=+$P(RESULT,":",2) ;file #350 RX IEN
- . . . I $P(RESULT,":")=350 S OTHIBRX=0
- . . . I ACCTYP=3 S OTHIBRX=$P(RESULT,":",3) ;file #399 RX IEN
- . . . D RX1^DGOTHFS3
- . . Q:DGQ
- . Q:DGQ
- I DGQ K ^TMP($J,"OTHFSMR2"),^TMP($J,"OTHFSMRX") Q
- D RXNOSTAT^DGOTHFS3 ;Extract those RX's that has not been charge
- D PRINTRX^DGOTHFS4
- K ^TMP($J,"OTHFSMR2"),^TMP($J,"OTHFSMRX")
- W !!,"<< end of report >>"
- Q:DGQ
- D ASKCONT^DGOTHFSM(0) W @IOF
- Q
- ;
- LINE(FLAG) ;prints double dash line
- N LINE
- I FLAG<1 F LINE=1:1:132 W "="
- E F LINE=1:1:132 W "-"
- Q
- ;
- PTHDR(TITLE) ;patient name and DOB header
- S TITLE=$G(TITLE)
- I $G(TRM)!('$G(TRM)&DGPAGE) W @IOF
- I $L(TITLE) W ?132-$L(TITLE)\2,TITLE W !!
- S DGPAGE=$G(DGPAGE)+1
- W "Patient Name: ",DGPTNM_" ("_DGPID_")",?112,"DOB: ",$P(VADM(3),U,2),!
- Q
- ;
- HDR(FLAG) ;Primary Eligibility History header
- N TITLE
- S TITLE="PRIMARY ELIGIBILITY/EXPANDED CARE TYPE HISTORY"_$S(FLAG:" - Continuation",1:"")
- W ?132-$L(TITLE)\2,TITLE,!
- D LINE(1)
- W "Primary Eligibility",?60,"Date of Change",!
- D LINE(1)
- Q
- ;
- PAUSE(DGQ) ; pause screen display
- N J
- I $Y<(IOSL-4) D
- . F J=1:1 Q:($Y>(24-4)) W !
- I $G(DGPAGE)>0,TRM,$$E("Press <Enter> to continue or '^' to exit:")<1 S DGQ=1
- Q
- ;
- E(MSG) ; ----- ask user to press enter to continue
- ; Return: -2:Time-out; -1:'^'-out 1:anything else
- S MSG=$G(MSG)
- N X,Y,Z,DIR,DIROUT,DIRUT,DTOUT,DUOUT
- S DIR(0)="EA"
- I $L(MSG) S DIR("A")=MSG
- D ^DIR
- S X=$S($D(DTOUT):-2,$D(DUOUT):-1,1:1)
- Q X
- ;
- HELP ;provide extended DIR("?") help text.
- I (X="?")!(X="??") D
- . W !,"Select ""E""ligibility if you wish to see the Primary Eligibility history"
- . W !," Means Test, and Health Insurance information of the selected"
- . W !," patient.",!
- . W !,"Select ""A""ll if you wish to see the Primary Eligibility history,"
- . W !," Means Test, Health Insurance information, Patient's"
- . W !," Episodes of Care, and patient's Released Prescriptions"
- . W !," of the selected patient.",!
- Q
- ;
- CHKDATE(DATE,DGSORT) ;check if dates fall within the Begin and End dates
- Q DGSORT("DGBEG")<=DATE&(DGSORT("DGEND")>=DATE)
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGOTHFS2 19426 printed Jan 18, 2025@03:47:30 Page 2
- DGOTHFS2 ;SLC/RM - FORMER OTH PATIENT DETAIL REPORT 2 ; July 30,2020@09:44am
- +1 ;;5.3;Registration;**1025,1034,1035**;Aug 13, 1993;Build 14
- +2 ;
- +3 ;Global References Supported by ICR# Type
- +4 ;----------------- ----------------- ---------
- +5 ; ^DG(391 2966 (DG is the Custodial Package) Cont. Sub.
- +6 ; ^DIC(31 733 Cont. Sub.
- +7 ; ^TMP($J SACC 2.3.2.5.1
- +8 ;
- +9 ;External References
- +10 ;-------------------
- +11 ; HOME^%ZIS 10086 Supported
- +12 ; $$FINDCUR^DGENA 3812 (DG is the Custodial Package) Cont. Sub.
- +13 ; DISP^DGIBDSP 4408 (DG is the Custodial Package) Cont. Sub.
- +14 ; $$MTS^DGMTU 642 (DG is the Custodial Package) Cont. Sub.
- +15 ; DIS^DGMTU 3789 (DG is the Custodial Package) Cont. Sub.
- +16 ; $$RDIS^DGRPDB 4807 Supported
- +17 ; ^DIC 10006 Supported
- +18 ; WAIT^DICD 10024 Supported
- +19 ; RECALL^DILFD 2055 Supported
- +20 ; $$GET1^DIQ 2056 Supported
- +21 ; $$GET1^DIQ(27.11 4947 (DG is the Custodial Package) Private
- +22 ; ^DIR 10026 Supported
- +23 ; $$INSUR^IBBAPI 4419 Supported
- +24 ; EN^IBEFSMUT 7202 DG has permission to access) Private
- +25 ; RX^PSO52API 4820 Supported
- +26 ; 2^VADPT 10061 Supported
- +27 ; KVAR^VADPT 10061 Supported
- +28 ; $$SITE^VASITE 10112 Supported
- +29 ; $$FMTE^XLFDT 10103 Supported
- +30 ; $$CJ^XLFSTR 10104 Supported
- +31 ; EN^XUTMDEVQ 1519 Supported
- +32 ;
- +33 ;No direct call
- +34 QUIT
- +35 ;
- +36 ;Entry point for DG FORMER OTH PATIENTS DETAIL REPORT option
- MAIN ; Initial Interactive Processing
- +1 ;array of report parameters
- NEW DGSORT,IBOTHSTAT
- +2 NEW ZTDESC,ZTQUEUED,ZTREQ,ZTSAVE,ZTSTOP,DGPTNM,DGMTS,VAUTD,%ZIS,DGENCNT,SORTENCBY,DGRTNSTCK,DGPRTLRXFL
- +3 NEW INACTIVE,DGDFN,DFN,VAEL,VADM,VA,I3,DGPID,DGPAGE,DGRPTSRT,DGTOTALRX,IBOTHSTAT,DGTOTRX52
- +4 ;temp data storage for all records found in file #409.68,and #405 sorted by date of service
- NEW RECORD
- +5 ;temp data storage for all records found in file #409.68,and #405 sorted by division
- NEW RECORD1
- +6 ;check for database
- +7 IF '+$ORDER(^DGOTH(33,"B",""))
- WRITE !!!,$$CJ^XLFSTR(">>> No OTH records have been found. <<<",80)
- DO ASKCONT^DGOTHFSM(0)
- QUIT
- +8 WRITE @IOF
- +9 SET (INACTIVE,DGRPTSRT,DGRTNSTCK,DGPRTLRXFL)=0
- SET SORTENCBY=2
- +10 WRITE "FORMER OTH PATIENT DETAIL REPORT",!!
- +11 WRITE "This option assists billing user in reviewing Former Service Member's past"
- +12 WRITE !,"episodes of care and released prescription details to determine if"
- +13 WRITE !,"potential back-billing is necessary."
- +14 WRITE !!,"*** THIS REPORT REQUIRES 132 COLUMN OUTPUT TO PRINT CORRECTLY ***"
- +15 WRITE !!,"At the DEVICE: prompt, please accept the default value of '0;132;'"
- +16 WRITE !,"This is to deliberately avoid undesired wrapping problems of the data.",!!
- +17 ;prompt user to enter patient
- +18 DO PROMPTPT
- +19 if 'INACTIVE!(DGSORT'>0)
- QUIT
- +20 DO RECALL^DILFD(33,+DGSORT_",",DUZ)
- +21 ;Prompt user what type of data/report user wish to see
- +22 ;user had two options: Eligibility or Encounters
- +23 IF '$$RPTTYPE
- QUIT
- +24 SET RECORD=$NAME(^TMP($JOB,"DGOTHFSDOS"))
- +25 SET RECORD1=$NAME(^TMP($JOB,"DGOTHFSDIV"))
- +26 SET IBOTHSTAT=$NAME(^TMP($JOB,"IBOTHSTAT"))
- +27 ;temp data storage for all records found in file #409.68,and #405 sorted by date of service
- KILL @RECORD
- +28 ;temp data storage for all records found in file #409.68,and #405 sorted by division
- KILL @RECORD1
- +29 ;patient's RX information from File #52
- KILL ^TMP($JOB,"OTHFSMR2")
- +30 ;temporary storage for all Rx information and IB status ready for printing report
- KILL ^TMP($JOB,"OTHFSMRX")
- +31 ;temp storage for file #350 and file # 399 IB status
- KILL @IBOTHSTAT
- +32 ;if user select report type ALL, prompt user how it will be sorted
- +33 ;do not continue, if user does not select any sorting
- +34 IF DGSORT("RTYPE")="A"
- Begin DoDot:1
- +35 ;determine first the original date the former OTH service member become EXPANDED
- +36 ;MH CARE NON-ENROLLEE and loop through all the OTH Registration Date
- +37 SET DGIEN33=DGSORT
- SET (DGENCNT,DGTOTALRX,DGTOTRX52,DGRTNSTCK,DGPRTLRXFL)=0
- +38 ;the date when the patient became OTH
- SET DGSORT("DGBEG")=$$OTHREGDT(DGIEN33)
- +39 ;the date when the PE eligibility status of patient became VERIFIED
- SET DGSORT("DGEND")=$$GET1^DIQ(2,DGDFN_",",.3612,"I")
- +40 ;All the divisions in the facility, since we are not prompting user to enter Division
- SET VAUTD=1
- +41 ;check if there any past Outpatient Encounter entry (file #409.68) for this patient
- DO CHKTREAT^DGFSMOUT(DGDFN,DGSORT("DGBEG"),DGSORT("DGEND"),.VAUTD,0)
- +42 ;check if there any Inpatient stay entry in file #405
- DO CHECKPTF^DGFSMOUT(DGDFN,DGSORT("DGBEG"),DGSORT("DGEND"),"IBOTHSTAT")
- +43 ;check if this patient has records in file #350 or file #399
- DO CHECKIB^DGFSMOUT("IBOTHSTAT",DGSORT("DGBEG"),DGSORT("DGEND"))
- +44 ;get the medication profile of a patient from PRESCRIPTION file (#52)
- DO RX^PSO52API(DGDFN,"OTHFSMR2",,,"2,R,P",DGSORT("DGBEG"),$$FMADD^XLFDT(DGSORT("DGEND"),366))
- +45 ;before moving forward remove RX data from the patient's episode of care array first
- +46 ;determines whether to prompt Encounter sorting
- IF $ORDER(@RECORD@(""))'=""
- DO FLTRENC^DGOTHFS4
- +47 ;determines whether to prompt the Rx sorting and see if the Rx released date is within the date range
- IF DGTOTALRX<2
- SET DGTOTRX52=+$PIECE(^TMP($JOB,"OTHFSMR2",DGDFN,0),U)
- IF +DGTOTRX52>0
- DO TOTRX^DGOTHFS4
- +48 SET DGTOTALRX=DGTOTALRX+DGTOTRX52
- +49 ;extract in advance the IB STATUS in both file #350 and file #399
- IF $ORDER(@IBOTHSTAT@(""))=""
- DO EN^IBEFSMUT(DGDFN,DGSORT("DGBEG"),DGSORT("DGEND"),"IBOTHSTAT")
- +50 IF (DGENCNT>1)
- IF (DGTOTALRX>1)
- Begin DoDot:2
- +51 WRITE !!,"Please select sorting order for Episodes of Care and Released Prescription",!,"report section:"
- +52 ;prompt user how the Encounter report section will be sorted
- +53 IF '$$SORTENC^DGOTHFS3
- QUIT
- +54 ;prompt user Rx report section will be sorted
- +55 IF '$$SORTRX^DGOTHFS3
- QUIT
- +56 SET DGRPTSRT=1
- End DoDot:2
- QUIT
- +57 IF (DGENCNT>1)
- IF (DGTOTALRX<2)
- Begin DoDot:2
- +58 WRITE !!,"Please select sorting order for Episodes of Care report section:"
- +59 IF '$$SORTENC^DGOTHFS3
- QUIT
- +60 SET DGRPTSRT=1
- SET DGSORT("SORTRXBY")=1
- End DoDot:2
- QUIT
- +61 IF (DGENCNT<2)
- IF (DGTOTALRX>1)
- Begin DoDot:2
- +62 WRITE !!,"Please select sorting order for Released Prescription report section:"
- +63 IF '$$SORTRX^DGOTHFS3
- QUIT
- +64 SET DGRPTSRT=1
- +65 SET DGSORT("SORTENCBY")=1
- End DoDot:2
- QUIT
- +66 SET DGSORT("SORTENCBY")=1
- SET DGSORT("SORTRXBY")=1
- +67 SET DGRPTSRT=1
- End DoDot:1
- if DGRPTSRT<1
- QUIT
- +68 WRITE !!
- +69 SET %ZIS=""
- +70 SET %ZIS("B")="0;132;"
- +71 SET ZTSAVE("DGSORT(")=""
- +72 SET ZTSAVE("DGSORT")=""
- +73 SET ZTSAVE("DGDFN")=""
- +74 SET ZTSAVE("DGPTNM")=""
- +75 SET ZTSAVE("DGTOTALRX")=""
- +76 SET X="FORMER OTH PATIENT ELIGIBILITY CHANGE REPORT"
- +77 DO EN^XUTMDEVQ("START^DGOTHFS2",X,.ZTSAVE,.%ZIS)
- +78 DO HOME^%ZIS
- +79 QUIT
- +80 ;
- START ;starting point to generate report
- +1 IF $EXTRACT(IOST)="C"
- DO WAIT^DICD
- +2 ;extract the IEN and facility name where the report is run
- NEW HERE
- SET HERE=$$SITE^VASITE
- +3 NEW TRM
- SET TRM=($EXTRACT(IOST)="C")
- +4 SET (DGQ,DGPAGE,I3)=0
- +5 SET DGIEN33=DGSORT
- +6 SET DFN=DGDFN
- +7 SET DGPID=$$GET1^DIQ(2,DFN_",",.0905,"I")
- +8 ;display the patient's current and verified eligibility
- +9 DO CURRENT(DGDFN,DGPTNM)
- +10 WRITE !
- +11 ;display patient's Means Test Status information
- +12 DO MTS(DGDFN)
- +13 ;display patient's Rated Disabilities information
- +14 DO RTDDIS(DGDFN)
- +15 if DGQ
- QUIT
- +16 ;display patient's Insurance information
- +17 DO INS(DGDFN)
- +18 if DGQ
- QUIT
- +19 ;display patient's all Primary Eligibility history
- +20 DO HISTORY(DGIEN33)
- +21 if DGQ
- QUIT
- +22 ;if user wants to see patient Encounter and Rx information
- +23 IF DGSORT("RTYPE")="A"
- Begin DoDot:1
- +24 ;display patient's checked out Encounters and inpatient data
- +25 DO ENCTR(DGDFN,.DGSORT)
- +26 if DGQ
- QUIT
- +27 ;display patient's Released Prescriptions
- +28 DO RX(DGDFN,.DGSORT)
- End DoDot:1
- +29 DO KVAR^VADPT
- +30 KILL @RECORD,@RECORD1,@IBOTHSTAT,^TMP($JOB,"OTHFSMR2"),^TMP($JOB,"OTHFSMRX")
- +31 DO EXIT^DGOTHFSM
- +32 QUIT
- +33 ;
- PROMPTPT ;prompt user to enter patient
- +1 ;keep prompting for patient name until user enter patient with INACTIVE status
- +2 FOR
- Begin DoDot:1
- +3 ;Prompt user for OTH patient name
- +4 SET DGPTNM=$$SELPAT(.DGSORT)
- +5 IF DGSORT'>0
- SET INACTIVE=1
- QUIT
- +6 IF $$ACTIVE(.DGSORT)
- Begin DoDot:2
- +7 WRITE !!,"The patient you selected is still PENDING for VBA Adjudication."
- +8 DO RUNOPT
- End DoDot:2
- QUIT
- +9 ;if INACTIVE STATUS, check if the eligibility status is VERIFIED
- +10 SET DGDFN=$PIECE(DGSORT(0),U)
- +11 IF $$GET1^DIQ(2,DGDFN_",",.3611,"I")'="V"
- Begin DoDot:2
- +12 WRITE !!,"The primary eligibility status of the patient you selected is not VERIFIED."
- +13 DO RUNOPT
- End DoDot:2
- QUIT
- +14 SET INACTIVE=1
- End DoDot:1
- if INACTIVE
- QUIT
- +15 QUIT
- +16 ;
- RUNOPT ;display message to run FORMER OTH PATIENT ELIGIBILITY CHANGE REPORT option
- +1 WRITE !,"Please run FORMER OTH PATIENT ELIGIBILITY CHANGE REPORT option"
- +2 WRITE !,"to identify Former OTH Service Member whose Primary Eligibility"
- +3 WRITE !,"changed from EXPANDED MH CARE NON-ENROLLEE to a new Primary"
- +4 WRITE !,"Eligibility with a VERIFIED eligibility status.",!
- +5 QUIT
- +6 ;
- ACTIVE(DGSORT) ;determine the current status of OTH patient
- +1 ;return 0 for INACTIVE
- +2 ;otherwise, 1 for ACTIVE
- +3 NEW DGIEN33,DGOTHSTAT
- +4 SET DGIEN33=DGSORT
- +5 SET DGOTHSTAT=$$GET1^DIQ(33,DGIEN33_",",.02,"I")
- +6 QUIT DGOTHSTAT
- +7 ;
- SELPAT(DGSORT) ;prompt for veteran's name
- +1 ;- input vars for ^DIC call
- +2 NEW DIC,DTOUT,DUOUT,X,Y
- +3 SET DIC="^DGOTH(33,"
- SET DIC(0)="AEMQZV"
- +4 SET DIC("A")="Enter Patient Name: "
- +5 SET DIC("?PARAM",33,"INDEX")="B"
- +6 SET DIC("?N",33)=12
- +7 ;- lookup patient
- +8 DO ^DIC
- KILL DIC
- +9 ;- result of lookup
- +10 SET DGSORT=Y
- +11 ;- if success, setup return array using output vars from ^DIC call
- +12 ;patient name
- IF (+DGSORT>0)
- Begin DoDot:1
- +13 ;patient ien
- SET DGSORT=+Y
- +14 ;zero node of patient in (#2) file
- SET DGSORT(0)=$GET(Y(0))
- End DoDot:1
- QUIT Y(0,0)
- +15 QUIT -1
- +16 ;
- RPTTYPE() ;prompt for type of data user wish to see
- +1 NEW DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO
- +2 SET DGDIRA="Select the type of report ('E'ligibility/'A'll): "
- +3 SET DGDIRB=""
- +4 SET DGDIRH="^D HELP^DGOTHFS2"
- +5 SET DGDIRO="SAO^E:Eligibility;A:All (Eligibility, Episodes of Care, Prescription)"
- +6 SET DGASK=$$ANSWER^DGOTHFSM(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
- +7 IF DGASK="E"!(DGASK="A")
- SET DGSORT("RTYPE")=DGASK
- SET DGASK=1
- +8 IF '$TEST
- SET DGASK=0
- +9 QUIT DGASK
- +10 ;
- CURRENT(DFN,PTNAME) ;display patient current and verified PE eligibility
- +1 NEW I1,DGENR,DGENRIEN,DGENRPRI,DGENRGRP
- +2 SET (DGENRIEN,DGENRPRI,DGENRGRP)=""
- +3 DO 2^VADPT
- +4 DO PTHDR("FORMER OTH PATIENT DETAIL REPORT")
- +5 DO LINE(0)
- +6 WRITE !,"Current Eligibility Code : ",$PIECE(VAEL(1),"^",2)," -- ",$SELECT(VAEL(8)']"":"NOT VERIFIED",1:$PIECE(VAEL(8),"^",2))
- +7 ;PE eligibility changed date
- WRITE " ",$$FMTE^XLFDT($$GET1^DIQ(2,DGDFN_",",.3612,"I"),"5Z")
- +8 WRITE !,"Other Eligibility Code(s): "
- IF $DATA(VAEL(1))>9
- SET I1=0
- FOR I=0:0
- SET I=$ORDER(VAEL(1,I))
- if 'I
- QUIT
- SET I1=I1+1
- if I1>1
- WRITE !?28
- WRITE $PIECE(VAEL(1,I),"^",2)
- +9 IF '$TEST
- WRITE "NO ADDITIONAL ELIGIBILITIES IDENTIFIED"
- +10 SET DGENRIEN=$$FINDCUR^DGENA(DFN)
- +11 IF DGENRIEN'=""
- SET DGENRPRI=$$GET1^DIQ(27.11,DGENRIEN_",",.07,"E")
- SET DGENRGRP=$$GET1^DIQ(27.11,DGENRIEN_",",.12,"E")
- +12 WRITE !,"Enrollment Priority : ",$SELECT(DGENRIEN="":"NOT ENROLLED",((DGENRPRI="")&(DGENRGRP="")):"NONE STATED",1:DGENRPRI_DGENRGRP)
- +13 WRITE !
- DO LINE(1)
- +14 QUIT
- +15 ;
- MTS(DFN) ;display patient's Means Test Status information
- +1 SET DGMTS=$$MTS^DGMTU(DFN)
- +2 IF DGMTS=""
- WRITE !,"Means Test Status : NOT IN MEANS TEST FILE"
- +3 IF '$TEST
- DO DIS^DGMTU(DFN)
- +4 QUIT
- +5 ;
- RTDDIS(DFN) ;display patient's rated disabilities information
- +1 NEW DGPTYPE,DGC,DGARR
- +2 WRITE !!,"Service Connected : ",$SELECT('+VAEL(3):"NO",1:"YES")
- +3 if +VAEL(3)
- WRITE ?33,"SC Percent : ",$PIECE(VAEL(3),"^",2)_"%"
- +4 WRITE !!,"Rated Disabilities: "
- IF 'VAEL(4)
- IF $SELECT('$DATA(^DG(391,+VAEL(6),0)):1,$PIECE(^(0),"^",2):0,1:1)
- WRITE "NOT A VETERAN"
- QUIT
- +5 IF '$$RDIS^DGRPDB(DFN,.DGARR)
- WRITE "NONE STATED"
- QUIT
- +6 FOR DGC=0:0
- SET DGC=$ORDER(DGARR(DGC))
- if 'DGC
- QUIT
- Begin DoDot:1
- +7 SET I3=I3+1
- +8 NEW DGP1,DGP2,DGP3,DGZERO
- +9 IF $GET(DGARR(DGC))']""
- QUIT
- +10 SET DGZERO=+DGARR(DGC)
- +11 IF '$DATA(^DIC(31,DGZERO,0))
- QUIT
- +12 SET DGP1=$PIECE(^DIC(31,DGZERO,0),U,3)
- +13 SET DGP2=$PIECE(^DIC(31,DGZERO,0),U)
- +14 SET DGP3="("_$SELECT($PIECE(DGARR(DGC),U,3)=1:$PIECE(DGARR(DGC),U,2)_"% SC",$PIECE(DGARR(DGC),U,3)]"":$PIECE(DGARR(DGC),U,2)_"% NSC",1:"Unspecified")_")"
- +15 IF $Y>(IOSL-4)
- WRITE !
- DO PAUSE(.DGQ)
- if DGQ
- QUIT
- DO PTHDR
- DO LINE(0)
- +16 if I3>1
- WRITE !?20
- +17 WRITE $GET(DGP1)_" - ",$EXTRACT(DGP2,1,30)," ",DGP3
- End DoDot:1
- if DGQ
- QUIT
- +18 if 'I3
- WRITE "NONE STATED"
- +19 QUIT
- +20 ;
- INS(DFN) ;display patient's health insurance information
- +1 NEW Z,I,I1
- +2 ;if patient had more than 6 rated disability, then display the insurance information in a separate page
- +3 IF I3>6
- WRITE !!
- DO PAUSE(.DGQ)
- if DGQ
- QUIT
- DO PTHDR
- DO LINE(0)
- +4 WRITE !!,"Health Insurance : "
- +5 SET Z=$$INSUR^IBBAPI(DFN,DT)
- +6 WRITE $SELECT(Z:"YES",1:"NO")
- +7 DO DISP^DGIBDSP
- +8 KILL I,I1,Z
- +9 IF $GET(DGMTS)=""
- WRITE !
- +10 QUIT
- +11 ;
- HISTORY(IEN33) ;extract all eligibility history
- +1 NEW DGELHIST,DGOTHIST,DGRECNUM,DGLINE,DGOTHTYP
- +2 ;display this piece of information to its own page so that the report will not look cluttered
- +3 DO PAUSE(.DGQ)
- if DGQ
- QUIT
- DO PTHDR
- DO LINE(0)
- WRITE !
- +4 DO HDR(0)
- +5 WRITE !
- +6 KILL DGOTHIST
- +7 SET DGELHIST=$$CROSS^DGOTHINQ(IEN33,.DGOTHIST)
- +8 ;go through all the eligibility history and only display date starting from Feb. 20,2020
- +9 ;3200220 is the Release Date of EXPANDED MH CARE NON-ENROLLEE
- +10 SET DGRECNUM=""
- FOR
- SET DGRECNUM=$ORDER(DGOTHIST(IEN33,DGRECNUM))
- if DGRECNUM=""
- QUIT
- Begin DoDot:1
- +11 IF $Y>(IOSL-4)
- WRITE !
- DO PAUSE(.DGQ)
- if DGQ
- QUIT
- DO PTHDR
- DO LINE(0)
- WRITE !!
- DO HDR(1)
- +12 SET DGLINE=DGOTHIST(IEN33,DGRECNUM)
- +13 SET DGOTHTYP=$$OTHTYP^DGOTHINQ($PIECE(DGLINE,U))
- +14 WRITE $SELECT($PIECE(DGLINE,U)="":"UNKNOWN",+DGOTHTYP:"EXPANDED MH CARE NON-ENROLLEE"_" ("_$PIECE(DGLINE,U)_")",1:$PIECE(DGLINE,U))
- +15 IF $PIECE(DGLINE,U)="EXPANDED MH CARE NON-ENROLLEE"
- WRITE " (N/A)"
- +16 WRITE ?60,$$FMTE^XLFDT($PIECE(DGLINE,U,2),"5Z")
- +17 WRITE !
- End DoDot:1
- if DGQ
- QUIT
- +18 ;break before going back to parent menu
- +19 IF DGSORT("RTYPE")="E"
- WRITE !!,"<< end of report >>"
- DO ASKCONT^DGOTHFSM(0)
- WRITE @IOF
- +20 QUIT
- +21 ;
- OTHREGDT(DGIEN33) ;determine the original date the former OTH service member become EXPANDED MH CARE NON-ENROLLEE
- +1 ;return the original OTH registration date
- +2 NEW DGFOUND,DGTOTREC,DGRECNUM,DGOTHARR,DGOTHREGDT,DGERR,DGREGDT,II
- +3 SET (DGFOUND,DGTOTREC,DGOTHREGDT)=0
- +4 SET DGTOTREC=$PIECE(^DGOTH(33,DGIEN33,2,0),U,4)
- +5 if +DGTOTREC<1
- QUIT
- +6 FOR II=1:1:DGTOTREC
- SET DGREGDT(II)=""
- +7 SET DGRECNUM=""
- FOR
- SET DGRECNUM=$ORDER(DGREGDT(DGRECNUM))
- if DGRECNUM=""!(DGFOUND)
- QUIT
- Begin DoDot:1
- +8 KILL DGOTHARR,DGERR
- +9 DO GETS^DIQ(33,DGIEN33_",","2*","IE","DGOTHARR","DGERR")
- +10 if $DATA(DGERR)
- QUIT
- +11 ;check if the eligibility is EXPANDED MH CARE NON-ENROLLEE
- +12 IF DGOTHARR(33.02,DGRECNUM_","_DGIEN33_",",.02,"E")="EXPANDED MH CARE NON-ENROLLEE"
- Begin DoDot:2
- +13 ;the original OTH registration date
- +14 SET DGOTHREGDT=$GET(DGOTHARR(33.02,DGRECNUM_","_DGIEN33_",",.01,"I"))
- +15 SET DGFOUND=1
- End DoDot:2
- End DoDot:1
- +16 QUIT DGOTHREGDT\1
- +17 ;
- ENCTR(DFN,DGSORT) ;display patient's episodes of care
- +1 NEW DGDIV,DGENCTRDT,DGTOTENC,SUB1,SUB2,JJ,DGENCTRIB,FILENO,STAT350,STAT399,BILLNO,ACRTYP,CHRGCNT,PRINTRPT
- +2 ;display this piece of information to its own page so that the report will not look cluttered
- +3 DO PAUSE(.DGQ)
- if DGQ
- QUIT
- DO PTHDR
- DO LINE(0)
- +4 DO ENCHDR(0)
- DO ENCTRCOL
- DO LINE(1)
- +5 SET (DGTOTENC,PRINTRPT)=0
- +6 IF $ORDER(@RECORD@(""))=""
- Begin DoDot:1
- +7 WRITE !!,">> NO DATA FOUND FROM "_$$FMTE^XLFDT(DGSORT("DGBEG"),"5ZF")_" TO "_$$FMTE^XLFDT(DGSORT("DGEND"),"5ZF")_"."
- +8 WRITE !
- DO LINE(1)
- +9 if DGQ
- QUIT
- +10 WRITE !!,"Total Number of Encounter: ",DGTOTENC
- End DoDot:1
- +11 IF '$TEST
- Begin DoDot:1
- +12 IF 'PRINTRPT
- Begin DoDot:2
- +13 IF $PIECE(DGSORT("SORTENCBY"),U)=2
- Begin DoDot:3
- +14 KILL @RECORD
- +15 MERGE @RECORD=@RECORD1
- +16 KILL @RECORD1
- End DoDot:3
- +17 ;extract the IB status
- DO ENCTRIB^DGOTHFS3
- +18 SET PRINTRPT=1
- End DoDot:2
- +19 ;use the same loop to display status
- DO ENCTRIB^DGOTHFS3
- End DoDot:1
- +20 QUIT
- +21 ;
- ENCTRCOL ;display encounter column name
- +1 WRITE !,"Location of",?22,"Clinic Stop/",?45,"Primary",?55,"Div.",?61,"Date of",?72,"Last Updated",?89,"Bill #",?100,"Action Type/",?116,"IB Status"
- +2 WRITE !,"Care",?22,"Treating Specialty",?45,"DX",?61,"Service",?77,"By",?100,"Rate Type",!
- +3 QUIT
- +4 ;
- ENCHDR(FLAG) ;Encounter Header
- +1 NEW TITLE
- +2 SET TITLE="PATIENT'S EPISODE OF CARE"_$SELECT(FLAG:" - Continuation",1:"")
- +3 WRITE !,?132-$LENGTH(TITLE)\2,TITLE,!
- +4 DO DTRANGE
- +5 SET TITLE="Sorted By: "_$EXTRACT($PIECE(DGSORT("SORTENCBY"),U,2),4,20)
- +6 IF $PIECE(DGSORT("SORTENCBY"),U,2)'=""
- WRITE ?132-$LENGTH(TITLE)\2,TITLE,!
- +7 DO LINE(1)
- +8 QUIT
- +9 ;
- DTRANGE ;display date range
- +1 NEW DTRANGE
- +2 SET DTRANGE="Date Range: "_$$FMTE^XLFDT(DGSORT("DGBEG"),"5ZF")_" - "_$$FMTE^XLFDT(DGSORT("DGEND"),"5ZF")
- +3 WRITE ?132-$LENGTH(DTRANGE)\2,DTRANGE,!
- +4 QUIT
- +5 ;
- RX(DFN,DGSORT) ;extract patient's released prescription
- +1 NEW FILENO,OTHIBDT,OTHIBREC,ACCTYP,RESULT,CNTR,OTHIBRX
- +2 ;display this piece of information to its own page so that the report will not look cluttered
- +3 DO PAUSE(.DGQ)
- if DGQ
- QUIT
- DO PTHDR
- DO LINE(0)
- +4 ;traverse ^TMP($J,"IBOTHSTAT" if the dates listed exist
- +5 ;in the ^TMP($J,"OTHFSMR2", this is where all the RX's of the patient
- +6 ;is stored.
- +7 SET CNTR=0
- +8 FOR FILENO=350,399
- Begin DoDot:1
- +9 if $PIECE(^TMP($JOB,"IBOTHSTAT",FILENO,DFN,0),U)<1
- QUIT
- +10 SET OTHIBDT=""
- FOR
- SET OTHIBDT=$ORDER(^TMP($JOB,"IBOTHSTAT",FILENO,OTHIBDT))
- if OTHIBDT=""
- QUIT
- Begin DoDot:2
- +11 SET OTHIBREC=""
- FOR
- SET OTHIBREC=$ORDER(^TMP($JOB,"IBOTHSTAT",FILENO,OTHIBDT,DFN,OTHIBREC))
- if OTHIBREC=""
- QUIT
- Begin DoDot:3
- +12 ;quit if not within the date range selected by the user
- +13 if '$$CHKDATE(OTHIBDT,.DGSORT)
- QUIT
- +14 IF FILENO=350
- Begin DoDot:4
- +15 SET ACCTYP=$PIECE(^TMP($JOB,"IBOTHSTAT",FILENO,OTHIBDT,DFN,OTHIBREC),U)
- End DoDot:4
- if ACCTYP'["RX"
- QUIT
- +16 IF FILENO=399
- Begin DoDot:4
- +17 SET ACCTYP=$PIECE($PIECE($PIECE(^TMP($JOB,"IBOTHSTAT",FILENO,OTHIBDT,DFN,OTHIBREC),U,5),";"),":")
- End DoDot:4
- if $PIECE(ACCTYP,U)'=3
- QUIT
- +18 SET RESULT=$PIECE(^TMP($JOB,"IBOTHSTAT",FILENO,OTHIBDT,DFN,OTHIBREC),U,5)
- +19 ;file #350 RX IEN
- IF $PIECE(RESULT,":")=52
- SET OTHIBRX=+$PIECE(RESULT,":",2)
- +20 IF $PIECE(RESULT,":")=350
- SET OTHIBRX=0
- +21 ;file #399 RX IEN
- IF ACCTYP=3
- SET OTHIBRX=$PIECE(RESULT,":",3)
- +22 DO RX1^DGOTHFS3
- End DoDot:3
- if DGQ
- QUIT
- +23 if DGQ
- QUIT
- End DoDot:2
- if DGQ
- QUIT
- +24 if DGQ
- QUIT
- End DoDot:1
- if DGQ
- QUIT
- +25 IF DGQ
- KILL ^TMP($JOB,"OTHFSMR2"),^TMP($JOB,"OTHFSMRX")
- QUIT
- +26 ;Extract those RX's that has not been charge
- DO RXNOSTAT^DGOTHFS3
- +27 DO PRINTRX^DGOTHFS4
- +28 KILL ^TMP($JOB,"OTHFSMR2"),^TMP($JOB,"OTHFSMRX")
- +29 WRITE !!,"<< end of report >>"
- +30 if DGQ
- QUIT
- +31 DO ASKCONT^DGOTHFSM(0)
- WRITE @IOF
- +32 QUIT
- +33 ;
- LINE(FLAG) ;prints double dash line
- +1 NEW LINE
- +2 IF FLAG<1
- FOR LINE=1:1:132
- WRITE "="
- +3 IF '$TEST
- FOR LINE=1:1:132
- WRITE "-"
- +4 QUIT
- +5 ;
- PTHDR(TITLE) ;patient name and DOB header
- +1 SET TITLE=$GET(TITLE)
- +2 IF $GET(TRM)!('$GET(TRM)&DGPAGE)
- WRITE @IOF
- +3 IF $LENGTH(TITLE)
- WRITE ?132-$LENGTH(TITLE)\2,TITLE
- WRITE !!
- +4 SET DGPAGE=$GET(DGPAGE)+1
- +5 WRITE "Patient Name: ",DGPTNM_" ("_DGPID_")",?112,"DOB: ",$PIECE(VADM(3),U,2),!
- +6 QUIT
- +7 ;
- HDR(FLAG) ;Primary Eligibility History header
- +1 NEW TITLE
- +2 SET TITLE="PRIMARY ELIGIBILITY/EXPANDED CARE TYPE HISTORY"_$SELECT(FLAG:" - Continuation",1:"")
- +3 WRITE ?132-$LENGTH(TITLE)\2,TITLE,!
- +4 DO LINE(1)
- +5 WRITE "Primary Eligibility",?60,"Date of Change",!
- +6 DO LINE(1)
- +7 QUIT
- +8 ;
- PAUSE(DGQ) ; pause screen display
- +1 NEW J
- +2 IF $Y<(IOSL-4)
- Begin DoDot:1
- +3 FOR J=1:1
- if ($Y>(24-4))
- QUIT
- WRITE !
- End DoDot:1
- +4 IF $GET(DGPAGE)>0
- IF TRM
- IF $$E("Press <Enter> to continue or '^' to exit:")<1
- SET DGQ=1
- +5 QUIT
- +6 ;
- E(MSG) ; ----- ask user to press enter to continue
- +1 ; Return: -2:Time-out; -1:'^'-out 1:anything else
- +2 SET MSG=$GET(MSG)
- +3 NEW X,Y,Z,DIR,DIROUT,DIRUT,DTOUT,DUOUT
- +4 SET DIR(0)="EA"
- +5 IF $LENGTH(MSG)
- SET DIR("A")=MSG
- +6 DO ^DIR
- +7 SET X=$SELECT($DATA(DTOUT):-2,$DATA(DUOUT):-1,1:1)
- +8 QUIT X
- +9 ;
- HELP ;provide extended DIR("?") help text.
- +1 IF (X="?")!(X="??")
- Begin DoDot:1
- +2 WRITE !,"Select ""E""ligibility if you wish to see the Primary Eligibility history"
- +3 WRITE !," Means Test, and Health Insurance information of the selected"
- +4 WRITE !," patient.",!
- +5 WRITE !,"Select ""A""ll if you wish to see the Primary Eligibility history,"
- +6 WRITE !," Means Test, Health Insurance information, Patient's"
- +7 WRITE !," Episodes of Care, and patient's Released Prescriptions"
- +8 WRITE !," of the selected patient.",!
- End DoDot:1
- +9 QUIT
- +10 ;
- CHKDATE(DATE,DGSORT) ;check if dates fall within the Begin and End dates
- +1 QUIT DGSORT("DGBEG")<=DATE&(DGSORT("DGEND")>=DATE)
- +2 ;