Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGOTHFS2

DGOTHFS2.m

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