DGOTHRP3 ;SLC/RM - OTH PATIENT PERIOD STATUS REPORT CONT. ;MAY 8, 2018@5:15
;;5.3;Registration;**952,977**;Aug 13, 1993;Build 177
;;Per VA Directive 6402, this routine should not be modified.
;
; Last Edited: SHRPE/RM - MAY 8, 2018 17:15
;
; ICR# TYPE DESCRIPTION
;----- ---- ---------------------
;10024 Sup WAIT^DICD
;10063 Sup $$S^%ZTLOAD
;10086 Sup HOME^%ZIS
;10089 Sup ^%ZISC
;10103 Sup ^XLFDT: $$FMTE, $$NOW
;10112 Sup $$SITE^VASITE
;10015 Sup GETS^DIQ
;10026 Sup ^DIR
;
;This routine will be used to display or print Other Than Honorable
;patient treated under OTH authority.
;
; INPUT: DGSORT() - see comments at the top of routine DGOTHRPT for
; explanation of DGSORT array
;
; Output: A formatted report of Other Than Honorable Statistical Report
;
;- no direct entry
Q
;
START ; compile and print report
I $E(IOST)="C" D WAIT^DICD
N HERE S HERE=$$SITE^VASITE ;extract the IEN and facility name
N TRM S TRM=($E(IOST)="C")
N DGLIST ;temp global name used for report list
N DGQRT ;array or report parameters for quarters
S DGLIST=$NA(^TMP("DGOTHST",$J))
N DGCNT,DGNET
K @DGLIST,DGCNT,DGNET
S (DGCNT,DGNET)=0
D LOOP(.DGSORT,DGLIST)
D PRINT1(.DGSORT,DGLIST,.DGCNT) ;by month or all month in the quarters
K @DGLIST
W !
D EXIT^DGOTHRP2
Q
;
LOOP(DGSORT,DGLIST) ;
I 123[$P(DGSORT("DGMON"),U) D LOOP2(.DGSORT,DGLIST) ;by month
I 4[$P(DGSORT("DGMON"),U) D LOOP1(.DGSORT,DGLIST) ;all month in the quarter
I 5[$P(DGSORT("DGMON"),U) D LOOP3(.DGSORT,DGLIST) ;fiscal year
Q
;
LOOP1(DGSORT,DGLIST) ;
; If 4[$P(DGSORT("DGMON"),U)
; - Then, build DGSORT("DGBEG") and DGSORT("DGEND")
; for each month on the fly
N DGMON,II
S II="" F S II=$O(DGSORT("DGMON",II)) Q:II="" D
. S DGMON=$$CALRNGE^DGOTHRPT(.DGSORT,"",II)
. S DGSORT("DGBEG")=$P(DGMON,U)
. S DGSORT("DGEND")=$P(DGMON,U,2)
. D LOOP2(.DGSORT,DGLIST)
Q
;
LOOP2(DGSORT,DGLIST) ;
N DGDFN,DGDIEN,DGQ,DGRES,DGIEN,DGOLD,DGQNUM,DGARR,DGRET,DGERR,DG90A,RET
;loop variable pointer flag x-ref file to run report
S (DGDFN,DGIEN,DGOLD)="",DGQ=0
F S DGDFN=$O(^DGOTH(33,"B",DGDFN)) Q:DGDFN="" D
. N DGIEN33,DFN,DGRES,DGPTSTAT,DGOSTAT,DGLS365D,DGLS365I
. K DGARR,DGRET,DGERR,DG90A,DGCLCK,RET
. S DGIEN33=$O(^DGOTH(33,"B",DGDFN,0)),(DGRES,DGOSTAT)=0
. D GETS^DIQ(33,DGIEN33_",",".01;.02;1*;2*","EI","DGARR","DGERR")
. Q:$D(DGERR)
. S DFN=$G(DGARR(33,DGIEN33_",",.01,"I")) ;patient's DFN
. D CLOCK^DGOTHRP2(DGIEN33)
. Q:'$D(DGCLCK)
. I $$MSNGPRD^DGOTHBTN(DGLS365D,.DGCLCK) Q
. D RESULT(.DGARR,.DG90A,DGIEN33)
. Q:'$D(DGRET)
. D SORT(.DGRET,.DGSORT,.DGCLCK)
Q
;
LOOP3(DGSORT,DGLIST) ;Fiscal year detail
; If 5[$P(DGSORT("DGMON"),U)
; - Then, build DGSORT("DGBEG") and DGSORT("DGEND")
; for each month in the quarter on the fly
N DGMON,DGQRTR,M,Q
S Q="" F S Q=$O(DGSORT("DGMON",Q)) Q:Q="" D
. S M="" F S M=$O(DGSORT("DGMON",Q,M)) Q:M="" D
. . S DGMON=$$CALRNGE^DGOTHRPT(.DGSORT,Q,M)
. . S DGSORT("DGBEG")=$P(DGMON,U)
. . S DGSORT("DGEND")=$P(DGMON,U,2)
. . S DGQRTR=Q
. . D LOOP2(.DGSORT,DGLIST)
Q
;
RESULT(DGARR,DG90A,DGIEN33) ;extract the 365 and 90 day period data for OTH patient
;
N DGIENS,DGDATE,I,II,DGAUTH,DGSDT,DGENDT,DGDIFF,DONE,DATASTR
S DGRES="",DONE=0
S DGDATE=$S($G(DGDATE)>0:DGDATE,1:DT)
F I=1:1:DGLS365D D Q:DONE
. I '$D(DGCLCK(I)) K DGRET S DONE=1,DGRES="" Q
. S DGRET(I)="",DGAUTH=""
. F II=1:1:DGCLCK(I) D Q:DONE
. . K DGIENS,DGSDT,DGENDT,DGDIFF
. . I DGCLCK(I,II)'=II K DGRET S DONE=1,DGRES="" Q
. . Q:DGCLCK(I,II)<1
. . S DGIENS=DGCLCK(I,II)_","_I_","_+DGIEN33_","
. . S DATASTR=$$GET90DT^DGOTHUT1(+DGIEN33,I,II)
. . S DGSDT=$P(DATASTR,U) ;start date
. . S DGENDT=$P(DATASTR,U,2) ;end date
. . I DGENDT'>0 S DGENDT=""
. . S DGDIFF=$P(DATASTR,U,3) ;days remaining
. . S DGAUTH=DGARR(33.11,DGIENS,.04,"I")
. . S DGRES=DGRES_DGSDT_U_DGENDT_U_DGDIFF_U
. . S DGRET(I,II)=DGSDT_U_DGENDT_U_DGDIFF_U_$S(II=1:"",1:DGAUTH)
. . ;determine which 90-Day period is considered "active" within the current 365-Day period
. . I DGRET(I)="" D
. . . I DGDIFF<1 S DGRET(I)=0 Q
. . . S DGRET(I)=II
. . I (DGDIFF>0),(DGDIFF<90),DGSDT<=DT S DGRET(I)=II Q
. . I DGDIFF=90,DGSDT>=DT,DGRET(I)<1 S DGRET(I)=II
Q DGRES
;
SORT(DGRET,DGSORT,DGCLCK) ;
;check if OTH-90 Patient will be included or
;excluded into the statistical report
N II,DG90,DGBEG,DGEND,DGNACTVN,DATA,DGDTOK,DGSSN
F II=1:1:DGLS365D D
. Q:'$D(DGCLCK(II))
. S DG90="" F S DG90=$O(DGRET(II,DG90)) Q:DG90="" D
. . K DGBEG,DGEND,DGNACTVN,DATA,DGDTOK,DGSSN
. . S DGBEG=$P(DGRET(II,DG90),U)
. . S DGEND=$P(DGRET(II,DG90),U,2)
. . S DGNACTVN=""
. . ;check if 90-Day period dates fall within the date range specified by the user
. . S DGDTOK=$$PRDDT(.DGSORT,DGBEG,DGEND) I DGDTOK D
. . . ;check OTH-90 patient status
. . . ;get the inactivation date if there is one
. . . I $$ISOTHD^DGOTHD(DGDFN)=0!'$$ISOTH90^DGOTHRP2(DGDFN) S DGNACTVN=$P($$CROSS^DGOTHINQ(DGIEN33),U,3)
. . . S DGIENS=DGCLCK(II,DG90)_","_II_","_+DGIEN33_","
. . . S DGPTNM=DGARR(33,DGIEN33_",",.01,"E")
. . . S DGSSN=$$GET1^DIQ(2,DFN_",",.0905,"","DGERR")
. . . S DGAUTH=$S($G(DGARR(33.11,DGIENS,.07,"E"))="":"N/A",1:$G(DGARR(33.11,DGIENS,.07,"E")))
. . . S DATA=II_U_DG90_U_DGSSN_U_$P(DGRET(II,DG90),U)_U_$P(DGRET(II,DG90),U,2)_U_$P(DGRET(II,DG90),U,3)_U_DGAUTH_U_DGNACTVN
. . . D BLD(.DGSORT,DGLIST,.DGRET,.DGARR,DATA,DGDTOK)
Q
;
PRDDT(DGSORT,DGBEG,DGEND) ;
;check if period of care dates fall within the date range specified by the user
N OK
S OK=0
S:DGBEG>=DGSORT("DGBEG")&(DGBEG<=DGSORT("DGEND")) OK=1
S:DGEND>=DGSORT("DGBEG")&(DGEND<=DGSORT("DGEND")) OK=2
S:DGBEG<=DGSORT("DGEND")&(DGEND>=DGSORT("DGEND")) OK=1
Q OK
;
BLD(DGSORT,DGLIST,DGRET,DGARR,DATA,DGDTOK) ;
;build and count the new and old oth patients
N DGMON,DGVASSN
S DGMON=$S(DGDTOK=1:+$E($P(DATA,U,4),4,5),1:+$E($P(DATA,U,5),4,5))
I DGSORT("DGBEG")<=$P(DATA,U,4),(DGSORT("DGEND"))>=$P(DATA,U,4) D
. D BLDNEW(DGPTNM,DATA)
. S DGCNT("NEW")=$G(DGCNT("NEW"))+1
. I 123[$P(DGSORT("DGMON"),U) S DGCNT("NEW",$P(DATA,U,2))=$G(DGCNT("NEW",$P(DATA,U,2)))+1
. E S DGCNT("NEW",DGMON)=$G(DGCNT("NEW",DGMON))+1
. D CALCIN(DATA,1,DGMON)
E D
. I DGDTOK>1,$D(DGRET(II,DG90+1)),DGMON=+$E($P(DGRET(II,DG90+1),U),4,5) D Q
. . ;means patient has a consecutive treatment whose date
. . ;falls within the date range.
. . ;so do not list them as carryover per request of Dr. Garcia
. . D BLDNEW(DGPTNM,DATA)
. D BLDOLD(DGPTNM,DATA)
. S DGCNT("OLD")=$G(DGCNT("OLD"))+1
. I 123[$P(DGSORT("DGMON"),U) S DGCNT("OLD",$P(DATA,U,2))=$G(DGCNT("OLD",$P(DATA,U,2)))+1
. E S DGCNT("OLD",+$E(DGSORT("DGBEG"),4,5))=$G(DGCNT("OLD",+$E(DGSORT("DGBEG"),4,5)))+1
. D CALCIN(DATA,0,+$E(DGSORT("DGBEG"),4,5))
S DGCNT=$G(DGCNT("NEW"))+$G(DGCNT("OLD"))
;count the total unique OTH patients for the entire fiscal year
I 5[$P(DGSORT("DGMON"),U),'$D(DGNET(DGIEN33,DGPTNM)) D
. S DGNET(DGIEN33,DGPTNM)=""
. S DGNET=DGNET+1
Q
;
BLDNEW(DGPTNM,DATA) ;
S @DGLIST@("NEW",DGMON,$S(1234[$P(DGSORT("DGMON"),U):$P(DGSORT("DGQTR"),U),1:DGQRTR),DGPTNM,$P(DATA,U,2))=DATA
Q
;
BLDOLD(DGPTNM,DGMON,DGCLCK,DGTMP) ;
S @DGLIST@("OLD",+$E(DGSORT("DGBEG"),4,5),$S(1234[$P(DGSORT("DGMON"),U):$P(DGSORT("DGQTR"),U),1:DGQRTR),DGPTNM,$P(DATA,U,2))=DATA
Q
;
PRINT1(DGSORT,DGLIST,DGCNT) ;display by month or month in the quarter
N DGPAGE,DDASH,DGFLG,DGQ,DGSTDT,DGPTNM,DGSTR,DGOLD,DGMON
N DGPR1,DGPR2,DGSTAT,DGMNAME,DGP1TOT,DGP2TOT,DGQRTR,DGC1,DGC2
S (DGQ,DGPAGE)=0,(DDASH,DGLN,DGOLD)="",$P(DDASH,"-",81)=""
I $O(@DGLIST@(""))="" D Q
. D HEAD
. W !!," >>> No Records were found using the report criteria.",!
. D ASKCONT^DGOTHMG2
; loop and display report
S (DGPR1,DGPR2,DGC1,DGC2,DGP1TOT,DGP2TOT)=0
;loop and display report by monthly or all months in the quarter
I 1234[$P(DGSORT("DGMON"),U) D Q:DGQ
. S DGMON="" F S DGMON=$O(DGSORT("DGMON",DGMON)) Q:DGMON="" D Q:DGQ
. . S DGMNAME=$P(DGSORT("DGMON",DGMON),U) ;month name
. . D PRINT2
;loop and display report for the entire FISCAL YEAR
I 5[$P(DGSORT("DGMON"),U) D Q:DGQ
. D FYEAR
;
I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q
N DGLN,DGTOTQ,DGTOTP1,DGTOTP2,DGGRND
S DGLN=""
I $E(IOST)'="C" W !
S (DGTOTQ,DGTOTP1,DGTOTP2,DGGRND)=0
I 123[$P(DGSORT("DGMON"),U) D MRPTSUM ;monthly report summary
;quarterly/fiscal report summary
I 45[$P(DGSORT("DGMON"),U) D CONT^DGOTHRP4(.DGSORT)
W !!,"<END OF REPORT>"
D ASKCONT^DGOTHMG2
Q
;
PRINT2 ;
;OTH-90 patient that newly started their treatment
N STATUS
S STATUS=1
I $D(@DGLIST@("NEW",DGMON)) D Q:DGQ
. D HEAD,SUBHEAD(1,DGMNAME),PRNTNEW
E D HEAD,SUBHEAD(1,DGMNAME),NOREC(1)
Q:DGQ
;per Dr. Garcia, do not display the lists of carry-over OTH-90 patients
;if user selects all months in the quarter, instead, immediately display
;the total number of all carry-over OTH-90 patients for that month
I 45[$P(DGSORT("DGMON"),U) D DSPLYCRY Q
;OTH-90 patient whose treatment has been carried-over
;or continued to the following month
Q:DGQ
I $D(@DGLIST@("OLD",DGMON)) D Q:DGQ
. D HEAD,SUBHEAD(0,DGMNAME),PRNTOLD
E D HEAD,SUBHEAD(0,DGMNAME),NOREC(0)
Q:DGQ
Q
;
FYEAR ;loop and display report for the entire FISCAL YEAR
N DGQRT,DGMON
S DGQRT="" F S DGQRT=$O(DGSORT("DGMON",DGQRT)) Q:DGQRT="" D Q:DGQ
. S DGMON="" F S DGMON=$O(DGSORT("DGMON",DGQRT,DGMON)) Q:DGMON="" D Q:DGQ
. . S DGMNAME=$P(DGSORT("DGMON",DGQRT,DGMON),U) ;month name
. . D PRINT2
. Q:DGQ
Q
;
NOREC(STATUS) ;
W !," *** No "_$S(STATUS=1:"NEW",1:"CARRY-OVER")_" OTH-90 patient records were found",!
W:STATUS " that started treatment for this month."
I 123[$P(DGSORT("DGMON"),U) D
. I STATUS>0 W ! D DSPLYNW Q
. W !! D DSPLYCRY
I 45[$P(DGSORT("DGMON"),U) D DSPLYNW
Q
;
PRNTNEW ;OTH-90 newly started their treatment
S DGQRTR="" F S DGQRTR=$O(@DGLIST@("NEW",DGMON,DGQRTR)) Q:DGQRTR="" D Q:DGQ
. S DGPTNM="" F S DGPTNM=$O(@DGLIST@("NEW",DGMON,DGQRTR,DGPTNM)) Q:DGPTNM="" D Q:DGQ
. . S DGCLCK="" F S DGCLCK=$O(@DGLIST@("NEW",DGMON,DGQRTR,DGPTNM,DGCLCK)) Q:DGCLCK="" D Q:DGQ
. . . S DGSTR=@DGLIST@("NEW",DGMON,DGQRTR,DGPTNM,DGCLCK)
. . . W !
. . . I $Y>(IOSL-4) D PAUSE^DGOTHRP2(.DGQ) Q:DGQ D HEAD W !
. . . I DGPTNM'=DGOLD W $E(DGPTNM,1,20),?23,$P(DGSTR,U,3) ;patient name and PID
. . . S DGOLD=DGPTNM ;display the name and PID only once
. . . W ?31,$P(DGSTR,U,2),?37,$$FMTE^XLFDT($P(DGSTR,U,4),"5Z"),?49,$$FMTE^XLFDT($P(DGSTR,U,5),"5Z")
. . . ;display N/A in replacement for days remaining if 90-Day has been inactivated
. . . W ?61,$S($P(DGSTR,U,8)'="":$J("N/A",4),1:$J($P(DGSTR,U,6),4))
. . W ?68,$$FMTE^XLFDT($P(DGSTR,U,8),"5Z")
. . Q:DGQ
. Q:DGQ
Q:DGQ
DSPLYNW ;
W:45[$P(DGSORT("DGMON"),U) !
W !!,"New for "_DGMNAME,?26,"="
I 123[$P(DGSORT("DGMON"),U) W $S($G(DGCNT("NEW"))>0:$J(DGCNT("NEW"),5),1:$J(0,5)),!
E W $S($G(DGCNT("NEW",DGMON))>0:$J(DGCNT("NEW",DGMON),5),1:$J(0,5)),!
D:123[$P(DGSORT("DGMON"),U) PAUSE^DGOTHRP2(.DGQ) Q:DGQ
Q
;
PRNTOLD ;OTH-90 whose treatment carried/continued to the following month
S DGQRTR="" F S DGQRTR=$O(@DGLIST@("OLD",DGMON,DGQRTR)) Q:DGQRTR="" D Q:DGQ
. S DGPTNM="" F S DGPTNM=$O(@DGLIST@("OLD",DGMON,DGQRTR,DGPTNM)) Q:DGPTNM="" D Q:DGQ
. . S DGCLCK="" F S DGCLCK=$O(@DGLIST@("OLD",DGMON,DGQRTR,DGPTNM,DGCLCK)) Q:DGCLCK="" D Q:DGQ
. . . S DGSTR=@DGLIST@("OLD",DGMON,DGQRTR,DGPTNM,DGCLCK)
. . . I 45[$P(DGSORT("DGMON"),U) Q
. . . W !
. . . I $Y>(IOSL-4) D PAUSE^DGOTHRP2(.DGQ) Q:DGQ D HEAD W !
. . . I DGPTNM'=DGOLD W $E(DGPTNM,1,20),?23,$P(DGSTR,U,3) ;patient name and PID
. . . S DGOLD=DGPTNM ;display the name and PID only once
. . . W ?31,$P(DGSTR,U,2),?37,$$FMTE^XLFDT($P(DGSTR,U,4),"5Z"),?49,$$FMTE^XLFDT($P(DGSTR,U,5),"5Z")
. . . ;display N/A in replacement for days remaining if 90-Day has been inactivated
. . . W ?61,$S($P(DGSTR,U,8)'="":$J("N/A",4),1:$J($P(DGSTR,U,6),4))
. . W:123[$P(DGSORT("DGMON"),U) ?68,$$FMTE^XLFDT($P(DGSTR,U,8),"5Z")
. . Q:DGQ
. Q:DGQ
Q:DGQ
W !!
DSPLYCRY W "Carryover for "_DGMNAME,?26,"="
I 123[$P(DGSORT("DGMON"),U) W $S($G(DGCNT("OLD"))>0:$J(DGCNT("OLD"),5),1:$J(0,5)),!
E D
. W $S($G(DGCNT("OLD",DGMON))>0:$J(DGCNT("OLD",DGMON),5),1:$J(0,5)),!
. W "================================",!
. W "TOTAL",?26," ",$J(($G(DGCNT("NEW",DGMON)))+($G(DGCNT("OLD",DGMON))),5),!
D PAUSE^DGOTHRP2(.DGQ) Q:DGQ
Q
;
CALCIN(DGSTR,DGSTAT,DGMON) ;calculate inactivated OTH patients
I $P(DGSTR,U,8)'="" D
. I 123[$P(DGSORT("DGMON"),U) D
. . I DGSTAT<1 S DGCNT("OLD",$P(DGSTR,U,2),0)=$G(DGCNT("OLD",$P(DGSTR,U,2),0))+1
. . E S DGCNT("NEW",$P(DGSTR,U,2),0)=$G(DGCNT("NEW",$P(DGSTR,U,2),0))+1
. I 45[$P(DGSORT("DGMON"),U) S DGCNT("IN",DGMON)=$G(DGCNT("IN",DGMON))+1
Q
;
MRPTSUM ;monthly report summary
N TOTAL1,TOTAL2
D HEAD
W !,"REPORT SUMMARY for the month of ",$P(DGSORT("DGMON"),U,2),":"
W !!,?16,"90-DAY",?29,"NEW",?39,"CARRY OVER",?55,"TOTAL",?64,"|",?65,"INACTIVATED"
S $P(DGLN,"=",49)="" W !,?16,DGLN,?64,"|",?65,"============"
N I,TOTAL
S (TOTAL1,TOTAL2)=0
F I=1:1:5 D
. W !,?16,$J(I,4)
. ;I $D(DGCNT("NEW",I))!($D(DGCNT("OLD",I))) D
. I $D(DGCNT("NEW",I)) W ?29,$J(DGCNT("NEW",I),3)
. I $D(DGCNT("OLD",I)) W ?39,$J(DGCNT("OLD",I),5)
. I $D(DGCNT("NEW",I))!($D(DGCNT("OLD",I))) W ?55,$J($G(DGCNT("NEW",I))+($G(DGCNT("OLD",I))),5)
. E W ?55,$J(0,5)
. W ?64,"|"
. I $G(DGCNT("NEW",I,0))!($G(DGCNT("OLD",I,0))) D
. . W ?65,$J($G(DGCNT("NEW",I,0))+($G(DGCNT("OLD",I,0))),6)
. S TOTAL1=TOTAL1+($G(DGCNT("NEW",I)))+($G(DGCNT("OLD",I)))
. S TOTAL2=TOTAL2+($G(DGCNT("NEW",I,0)))+($G(DGCNT("OLD",I,0)))
S $P(DGLN,"=",65)="" W !,DGLN,?64,"|",?65,"============"
W !,"TOTAL",?29,$J($G(DGCNT("NEW")),3),?39,$J($G(DGCNT("OLD")),5),?55,$J($G(TOTAL1),5),?64,"|",?65,$J($G(TOTAL2),6)
Q
;
MONAME ;Month Name
;;1^January
;;2^February
;;3^March
;;4^April
;;5^May
;;6^June
;;7^July
;;8^August
;;9^September
;;10^October
;;11^November
;;12^December
Q
;
HEAD ;Print/Display Page Header Detail
I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
N DGFACLTY,DGPRD
I TRM!('TRM&DGPAGE) W @IOF
S DGPAGE=$G(DGPAGE)+1
S DGFACLTY="Facility: "_$P(HERE,U,2)
W !,?80-$L(ZTDESC)\2,$G(ZTDESC),?71,"Page:",?77,DGPAGE
W !,?80-$L(DGFACLTY)\2,DGFACLTY ;facility
S DGPRD="Report Period: "_$S(123[$P(DGSORT("DGMON"),U):"Month of "_$P(DGSORT("DGMON"),U,2),1:$P(DGSORT("DGMON"),U,2))
W !,?80-$L(DGPRD)\2,DGPRD
W !,"Date Range:",?12,DGDTRNGE
W ?45,"Date Printed:",?59,$$FMTE^XLFDT($$NOW^XLFDT,"MP")
W !,DDASH
W !,"PATIENT NAME",?23,"PID",?29,"PERIOD",?37,"START DATE",?49,"END DATE",?61,"DAYS",?68,"INACTIVATION"
W !,?61,"LEFT",?68,"DATE"
W !,DDASH,!
Q
;
SUBHEAD(DGSTAT,DGMNAME) ;display sub header
W !,$S(DGSTAT:"OTH-90 Patients that started treatment in ",1:"Carry-over OTH-90 Patients for ")
W DGMNAME_":"
W !
Q
;
HELP ;provide extended DIR("?") help text.
;
I X'="?",X'="??" W !," Not a valid fiscal year.",!
W !," Enter the fiscal year in this format: YY or YYYY"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGOTHRP3 15284 printed Nov 22, 2024@17:56:58 Page 2
DGOTHRP3 ;SLC/RM - OTH PATIENT PERIOD STATUS REPORT CONT. ;MAY 8, 2018@5:15
+1 ;;5.3;Registration;**952,977**;Aug 13, 1993;Build 177
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Last Edited: SHRPE/RM - MAY 8, 2018 17:15
+5 ;
+6 ; ICR# TYPE DESCRIPTION
+7 ;----- ---- ---------------------
+8 ;10024 Sup WAIT^DICD
+9 ;10063 Sup $$S^%ZTLOAD
+10 ;10086 Sup HOME^%ZIS
+11 ;10089 Sup ^%ZISC
+12 ;10103 Sup ^XLFDT: $$FMTE, $$NOW
+13 ;10112 Sup $$SITE^VASITE
+14 ;10015 Sup GETS^DIQ
+15 ;10026 Sup ^DIR
+16 ;
+17 ;This routine will be used to display or print Other Than Honorable
+18 ;patient treated under OTH authority.
+19 ;
+20 ; INPUT: DGSORT() - see comments at the top of routine DGOTHRPT for
+21 ; explanation of DGSORT array
+22 ;
+23 ; Output: A formatted report of Other Than Honorable Statistical Report
+24 ;
+25 ;- no direct entry
+26 QUIT
+27 ;
START ; compile and print report
+1 IF $EXTRACT(IOST)="C"
DO WAIT^DICD
+2 ;extract the IEN and facility name
NEW HERE
SET HERE=$$SITE^VASITE
+3 NEW TRM
SET TRM=($EXTRACT(IOST)="C")
+4 ;temp global name used for report list
NEW DGLIST
+5 ;array or report parameters for quarters
NEW DGQRT
+6 SET DGLIST=$NAME(^TMP("DGOTHST",$JOB))
+7 NEW DGCNT,DGNET
+8 KILL @DGLIST,DGCNT,DGNET
+9 SET (DGCNT,DGNET)=0
+10 DO LOOP(.DGSORT,DGLIST)
+11 ;by month or all month in the quarters
DO PRINT1(.DGSORT,DGLIST,.DGCNT)
+12 KILL @DGLIST
+13 WRITE !
+14 DO EXIT^DGOTHRP2
+15 QUIT
+16 ;
LOOP(DGSORT,DGLIST) ;
+1 ;by month
IF 123[$PIECE(DGSORT("DGMON"),U)
DO LOOP2(.DGSORT,DGLIST)
+2 ;all month in the quarter
IF 4[$PIECE(DGSORT("DGMON"),U)
DO LOOP1(.DGSORT,DGLIST)
+3 ;fiscal year
IF 5[$PIECE(DGSORT("DGMON"),U)
DO LOOP3(.DGSORT,DGLIST)
+4 QUIT
+5 ;
LOOP1(DGSORT,DGLIST) ;
+1 ; If 4[$P(DGSORT("DGMON"),U)
+2 ; - Then, build DGSORT("DGBEG") and DGSORT("DGEND")
+3 ; for each month on the fly
+4 NEW DGMON,II
+5 SET II=""
FOR
SET II=$ORDER(DGSORT("DGMON",II))
if II=""
QUIT
Begin DoDot:1
+6 SET DGMON=$$CALRNGE^DGOTHRPT(.DGSORT,"",II)
+7 SET DGSORT("DGBEG")=$PIECE(DGMON,U)
+8 SET DGSORT("DGEND")=$PIECE(DGMON,U,2)
+9 DO LOOP2(.DGSORT,DGLIST)
End DoDot:1
+10 QUIT
+11 ;
LOOP2(DGSORT,DGLIST) ;
+1 NEW DGDFN,DGDIEN,DGQ,DGRES,DGIEN,DGOLD,DGQNUM,DGARR,DGRET,DGERR,DG90A,RET
+2 ;loop variable pointer flag x-ref file to run report
+3 SET (DGDFN,DGIEN,DGOLD)=""
SET DGQ=0
+4 FOR
SET DGDFN=$ORDER(^DGOTH(33,"B",DGDFN))
if DGDFN=""
QUIT
Begin DoDot:1
+5 NEW DGIEN33,DFN,DGRES,DGPTSTAT,DGOSTAT,DGLS365D,DGLS365I
+6 KILL DGARR,DGRET,DGERR,DG90A,DGCLCK,RET
+7 SET DGIEN33=$ORDER(^DGOTH(33,"B",DGDFN,0))
SET (DGRES,DGOSTAT)=0
+8 DO GETS^DIQ(33,DGIEN33_",",".01;.02;1*;2*","EI","DGARR","DGERR")
+9 if $DATA(DGERR)
QUIT
+10 ;patient's DFN
SET DFN=$GET(DGARR(33,DGIEN33_",",.01,"I"))
+11 DO CLOCK^DGOTHRP2(DGIEN33)
+12 if '$DATA(DGCLCK)
QUIT
+13 IF $$MSNGPRD^DGOTHBTN(DGLS365D,.DGCLCK)
QUIT
+14 DO RESULT(.DGARR,.DG90A,DGIEN33)
+15 if '$DATA(DGRET)
QUIT
+16 DO SORT(.DGRET,.DGSORT,.DGCLCK)
End DoDot:1
+17 QUIT
+18 ;
LOOP3(DGSORT,DGLIST) ;Fiscal year detail
+1 ; If 5[$P(DGSORT("DGMON"),U)
+2 ; - Then, build DGSORT("DGBEG") and DGSORT("DGEND")
+3 ; for each month in the quarter on the fly
+4 NEW DGMON,DGQRTR,M,Q
+5 SET Q=""
FOR
SET Q=$ORDER(DGSORT("DGMON",Q))
if Q=""
QUIT
Begin DoDot:1
+6 SET M=""
FOR
SET M=$ORDER(DGSORT("DGMON",Q,M))
if M=""
QUIT
Begin DoDot:2
+7 SET DGMON=$$CALRNGE^DGOTHRPT(.DGSORT,Q,M)
+8 SET DGSORT("DGBEG")=$PIECE(DGMON,U)
+9 SET DGSORT("DGEND")=$PIECE(DGMON,U,2)
+10 SET DGQRTR=Q
+11 DO LOOP2(.DGSORT,DGLIST)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
RESULT(DGARR,DG90A,DGIEN33) ;extract the 365 and 90 day period data for OTH patient
+1 ;
+2 NEW DGIENS,DGDATE,I,II,DGAUTH,DGSDT,DGENDT,DGDIFF,DONE,DATASTR
+3 SET DGRES=""
SET DONE=0
+4 SET DGDATE=$SELECT($GET(DGDATE)>0:DGDATE,1:DT)
+5 FOR I=1:1:DGLS365D
Begin DoDot:1
+6 IF '$DATA(DGCLCK(I))
KILL DGRET
SET DONE=1
SET DGRES=""
QUIT
+7 SET DGRET(I)=""
SET DGAUTH=""
+8 FOR II=1:1:DGCLCK(I)
Begin DoDot:2
+9 KILL DGIENS,DGSDT,DGENDT,DGDIFF
+10 IF DGCLCK(I,II)'=II
KILL DGRET
SET DONE=1
SET DGRES=""
QUIT
+11 if DGCLCK(I,II)<1
QUIT
+12 SET DGIENS=DGCLCK(I,II)_","_I_","_+DGIEN33_","
+13 SET DATASTR=$$GET90DT^DGOTHUT1(+DGIEN33,I,II)
+14 ;start date
SET DGSDT=$PIECE(DATASTR,U)
+15 ;end date
SET DGENDT=$PIECE(DATASTR,U,2)
+16 IF DGENDT'>0
SET DGENDT=""
+17 ;days remaining
SET DGDIFF=$PIECE(DATASTR,U,3)
+18 SET DGAUTH=DGARR(33.11,DGIENS,.04,"I")
+19 SET DGRES=DGRES_DGSDT_U_DGENDT_U_DGDIFF_U
+20 SET DGRET(I,II)=DGSDT_U_DGENDT_U_DGDIFF_U_$SELECT(II=1:"",1:DGAUTH)
+21 ;determine which 90-Day period is considered "active" within the current 365-Day period
+22 IF DGRET(I)=""
Begin DoDot:3
+23 IF DGDIFF<1
SET DGRET(I)=0
QUIT
+24 SET DGRET(I)=II
End DoDot:3
+25 IF (DGDIFF>0)
IF (DGDIFF<90)
IF DGSDT<=DT
SET DGRET(I)=II
QUIT
+26 IF DGDIFF=90
IF DGSDT>=DT
IF DGRET(I)<1
SET DGRET(I)=II
End DoDot:2
if DONE
QUIT
End DoDot:1
if DONE
QUIT
+27 QUIT DGRES
+28 ;
SORT(DGRET,DGSORT,DGCLCK) ;
+1 ;check if OTH-90 Patient will be included or
+2 ;excluded into the statistical report
+3 NEW II,DG90,DGBEG,DGEND,DGNACTVN,DATA,DGDTOK,DGSSN
+4 FOR II=1:1:DGLS365D
Begin DoDot:1
+5 if '$DATA(DGCLCK(II))
QUIT
+6 SET DG90=""
FOR
SET DG90=$ORDER(DGRET(II,DG90))
if DG90=""
QUIT
Begin DoDot:2
+7 KILL DGBEG,DGEND,DGNACTVN,DATA,DGDTOK,DGSSN
+8 SET DGBEG=$PIECE(DGRET(II,DG90),U)
+9 SET DGEND=$PIECE(DGRET(II,DG90),U,2)
+10 SET DGNACTVN=""
+11 ;check if 90-Day period dates fall within the date range specified by the user
+12 SET DGDTOK=$$PRDDT(.DGSORT,DGBEG,DGEND)
IF DGDTOK
Begin DoDot:3
+13 ;check OTH-90 patient status
+14 ;get the inactivation date if there is one
+15 IF $$ISOTHD^DGOTHD(DGDFN)=0!'$$ISOTH90^DGOTHRP2(DGDFN)
SET DGNACTVN=$PIECE($$CROSS^DGOTHINQ(DGIEN33),U,3)
+16 SET DGIENS=DGCLCK(II,DG90)_","_II_","_+DGIEN33_","
+17 SET DGPTNM=DGARR(33,DGIEN33_",",.01,"E")
+18 SET DGSSN=$$GET1^DIQ(2,DFN_",",.0905,"","DGERR")
+19 SET DGAUTH=$SELECT($GET(DGARR(33.11,DGIENS,.07,"E"))="":"N/A",1:$GET(DGARR(33.11,DGIENS,.07,"E")))
+20 SET DATA=II_U_DG90_U_DGSSN_U_$PIECE(DGRET(II,DG90),U)_U_$PIECE(DGRET(II,DG90),U,2)_U_$PIECE(DGRET(II,DG90),U,3)_U_DGAUTH_U_DGNACTVN
+21 DO BLD(.DGSORT,DGLIST,.DGRET,.DGARR,DATA,DGDTOK)
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
PRDDT(DGSORT,DGBEG,DGEND) ;
+1 ;check if period of care dates fall within the date range specified by the user
+2 NEW OK
+3 SET OK=0
+4 if DGBEG>=DGSORT("DGBEG")&(DGBEG<=DGSORT("DGEND"))
SET OK=1
+5 if DGEND>=DGSORT("DGBEG")&(DGEND<=DGSORT("DGEND"))
SET OK=2
+6 if DGBEG<=DGSORT("DGEND")&(DGEND>=DGSORT("DGEND"))
SET OK=1
+7 QUIT OK
+8 ;
BLD(DGSORT,DGLIST,DGRET,DGARR,DATA,DGDTOK) ;
+1 ;build and count the new and old oth patients
+2 NEW DGMON,DGVASSN
+3 SET DGMON=$SELECT(DGDTOK=1:+$EXTRACT($PIECE(DATA,U,4),4,5),1:+$EXTRACT($PIECE(DATA,U,5),4,5))
+4 IF DGSORT("DGBEG")<=$PIECE(DATA,U,4)
IF (DGSORT("DGEND"))>=$PIECE(DATA,U,4)
Begin DoDot:1
+5 DO BLDNEW(DGPTNM,DATA)
+6 SET DGCNT("NEW")=$GET(DGCNT("NEW"))+1
+7 IF 123[$PIECE(DGSORT("DGMON"),U)
SET DGCNT("NEW",$PIECE(DATA,U,2))=$GET(DGCNT("NEW",$PIECE(DATA,U,2)))+1
+8 IF '$TEST
SET DGCNT("NEW",DGMON)=$GET(DGCNT("NEW",DGMON))+1
+9 DO CALCIN(DATA,1,DGMON)
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 IF DGDTOK>1
IF $DATA(DGRET(II,DG90+1))
IF DGMON=+$EXTRACT($PIECE(DGRET(II,DG90+1),U),4,5)
Begin DoDot:2
+12 ;means patient has a consecutive treatment whose date
+13 ;falls within the date range.
+14 ;so do not list them as carryover per request of Dr. Garcia
+15 DO BLDNEW(DGPTNM,DATA)
End DoDot:2
QUIT
+16 DO BLDOLD(DGPTNM,DATA)
+17 SET DGCNT("OLD")=$GET(DGCNT("OLD"))+1
+18 IF 123[$PIECE(DGSORT("DGMON"),U)
SET DGCNT("OLD",$PIECE(DATA,U,2))=$GET(DGCNT("OLD",$PIECE(DATA,U,2)))+1
+19 IF '$TEST
SET DGCNT("OLD",+$EXTRACT(DGSORT("DGBEG"),4,5))=$GET(DGCNT("OLD",+$EXTRACT(DGSORT("DGBEG"),4,5)))+1
+20 DO CALCIN(DATA,0,+$EXTRACT(DGSORT("DGBEG"),4,5))
End DoDot:1
+21 SET DGCNT=$GET(DGCNT("NEW"))+$GET(DGCNT("OLD"))
+22 ;count the total unique OTH patients for the entire fiscal year
+23 IF 5[$PIECE(DGSORT("DGMON"),U)
IF '$DATA(DGNET(DGIEN33,DGPTNM))
Begin DoDot:1
+24 SET DGNET(DGIEN33,DGPTNM)=""
+25 SET DGNET=DGNET+1
End DoDot:1
+26 QUIT
+27 ;
BLDNEW(DGPTNM,DATA) ;
+1 SET @DGLIST@("NEW",DGMON,$SELECT(1234[$PIECE(DGSORT("DGMON"),U):$PIECE(DGSORT("DGQTR"),U),1:DGQRTR),DGPTNM,$PIECE(DATA,U,2))=DATA
+2 QUIT
+3 ;
BLDOLD(DGPTNM,DGMON,DGCLCK,DGTMP) ;
+1 SET @DGLIST@("OLD",+$EXTRACT(DGSORT("DGBEG"),4,5),$SELECT(1234[$PIECE(DGSORT("DGMON"),U):$PIECE(DGSORT("DGQTR"),U),1:DGQRTR),DGPTNM,$PIECE(DATA,U,2))=DATA
+2 QUIT
+3 ;
PRINT1(DGSORT,DGLIST,DGCNT) ;display by month or month in the quarter
+1 NEW DGPAGE,DDASH,DGFLG,DGQ,DGSTDT,DGPTNM,DGSTR,DGOLD,DGMON
+2 NEW DGPR1,DGPR2,DGSTAT,DGMNAME,DGP1TOT,DGP2TOT,DGQRTR,DGC1,DGC2
+3 SET (DGQ,DGPAGE)=0
SET (DDASH,DGLN,DGOLD)=""
SET $PIECE(DDASH,"-",81)=""
+4 IF $ORDER(@DGLIST@(""))=""
Begin DoDot:1
+5 DO HEAD
+6 WRITE !!," >>> No Records were found using the report criteria.",!
+7 DO ASKCONT^DGOTHMG2
End DoDot:1
QUIT
+8 ; loop and display report
+9 SET (DGPR1,DGPR2,DGC1,DGC2,DGP1TOT,DGP2TOT)=0
+10 ;loop and display report by monthly or all months in the quarter
+11 IF 1234[$PIECE(DGSORT("DGMON"),U)
Begin DoDot:1
+12 SET DGMON=""
FOR
SET DGMON=$ORDER(DGSORT("DGMON",DGMON))
if DGMON=""
QUIT
Begin DoDot:2
+13 ;month name
SET DGMNAME=$PIECE(DGSORT("DGMON",DGMON),U)
+14 DO PRINT2
End DoDot:2
if DGQ
QUIT
End DoDot:1
if DGQ
QUIT
+15 ;loop and display report for the entire FISCAL YEAR
+16 IF 5[$PIECE(DGSORT("DGMON"),U)
Begin DoDot:1
+17 DO FYEAR
End DoDot:1
if DGQ
QUIT
+18 ;
+19 IF DGQ
if $DATA(ZTQUEUED)
WRITE !!,"REPORT STOPPED AT USER REQUEST"
QUIT
+20 NEW DGLN,DGTOTQ,DGTOTP1,DGTOTP2,DGGRND
+21 SET DGLN=""
+22 IF $EXTRACT(IOST)'="C"
WRITE !
+23 SET (DGTOTQ,DGTOTP1,DGTOTP2,DGGRND)=0
+24 ;monthly report summary
IF 123[$PIECE(DGSORT("DGMON"),U)
DO MRPTSUM
+25 ;quarterly/fiscal report summary
+26 IF 45[$PIECE(DGSORT("DGMON"),U)
DO CONT^DGOTHRP4(.DGSORT)
+27 WRITE !!,"<END OF REPORT>"
+28 DO ASKCONT^DGOTHMG2
+29 QUIT
+30 ;
PRINT2 ;
+1 ;OTH-90 patient that newly started their treatment
+2 NEW STATUS
+3 SET STATUS=1
+4 IF $DATA(@DGLIST@("NEW",DGMON))
Begin DoDot:1
+5 DO HEAD
DO SUBHEAD(1,DGMNAME)
DO PRNTNEW
End DoDot:1
if DGQ
QUIT
+6 IF '$TEST
DO HEAD
DO SUBHEAD(1,DGMNAME)
DO NOREC(1)
+7 if DGQ
QUIT
+8 ;per Dr. Garcia, do not display the lists of carry-over OTH-90 patients
+9 ;if user selects all months in the quarter, instead, immediately display
+10 ;the total number of all carry-over OTH-90 patients for that month
+11 IF 45[$PIECE(DGSORT("DGMON"),U)
DO DSPLYCRY
QUIT
+12 ;OTH-90 patient whose treatment has been carried-over
+13 ;or continued to the following month
+14 if DGQ
QUIT
+15 IF $DATA(@DGLIST@("OLD",DGMON))
Begin DoDot:1
+16 DO HEAD
DO SUBHEAD(0,DGMNAME)
DO PRNTOLD
End DoDot:1
if DGQ
QUIT
+17 IF '$TEST
DO HEAD
DO SUBHEAD(0,DGMNAME)
DO NOREC(0)
+18 if DGQ
QUIT
+19 QUIT
+20 ;
FYEAR ;loop and display report for the entire FISCAL YEAR
+1 NEW DGQRT,DGMON
+2 SET DGQRT=""
FOR
SET DGQRT=$ORDER(DGSORT("DGMON",DGQRT))
if DGQRT=""
QUIT
Begin DoDot:1
+3 SET DGMON=""
FOR
SET DGMON=$ORDER(DGSORT("DGMON",DGQRT,DGMON))
if DGMON=""
QUIT
Begin DoDot:2
+4 ;month name
SET DGMNAME=$PIECE(DGSORT("DGMON",DGQRT,DGMON),U)
+5 DO PRINT2
End DoDot:2
if DGQ
QUIT
+6 if DGQ
QUIT
End DoDot:1
if DGQ
QUIT
+7 QUIT
+8 ;
NOREC(STATUS) ;
+1 WRITE !," *** No "_$SELECT(STATUS=1:"NEW",1:"CARRY-OVER")_" OTH-90 patient records were found",!
+2 if STATUS
WRITE " that started treatment for this month."
+3 IF 123[$PIECE(DGSORT("DGMON"),U)
Begin DoDot:1
+4 IF STATUS>0
WRITE !
DO DSPLYNW
QUIT
+5 WRITE !!
DO DSPLYCRY
End DoDot:1
+6 IF 45[$PIECE(DGSORT("DGMON"),U)
DO DSPLYNW
+7 QUIT
+8 ;
PRNTNEW ;OTH-90 newly started their treatment
+1 SET DGQRTR=""
FOR
SET DGQRTR=$ORDER(@DGLIST@("NEW",DGMON,DGQRTR))
if DGQRTR=""
QUIT
Begin DoDot:1
+2 SET DGPTNM=""
FOR
SET DGPTNM=$ORDER(@DGLIST@("NEW",DGMON,DGQRTR,DGPTNM))
if DGPTNM=""
QUIT
Begin DoDot:2
+3 SET DGCLCK=""
FOR
SET DGCLCK=$ORDER(@DGLIST@("NEW",DGMON,DGQRTR,DGPTNM,DGCLCK))
if DGCLCK=""
QUIT
Begin DoDot:3
+4 SET DGSTR=@DGLIST@("NEW",DGMON,DGQRTR,DGPTNM,DGCLCK)
+5 WRITE !
+6 IF $Y>(IOSL-4)
DO PAUSE^DGOTHRP2(.DGQ)
if DGQ
QUIT
DO HEAD
WRITE !
+7 ;patient name and PID
IF DGPTNM'=DGOLD
WRITE $EXTRACT(DGPTNM,1,20),?23,$PIECE(DGSTR,U,3)
+8 ;display the name and PID only once
SET DGOLD=DGPTNM
+9 WRITE ?31,$PIECE(DGSTR,U,2),?37,$$FMTE^XLFDT($PIECE(DGSTR,U,4),"5Z"),?49,$$FMTE^XLFDT($PIECE(DGSTR,U,5),"5Z")
+10 ;display N/A in replacement for days remaining if 90-Day has been inactivated
+11 WRITE ?61,$SELECT($PIECE(DGSTR,U,8)'="":$JUSTIFY("N/A",4),1:$JUSTIFY($PIECE(DGSTR,U,6),4))
End DoDot:3
if DGQ
QUIT
+12 WRITE ?68,$$FMTE^XLFDT($PIECE(DGSTR,U,8),"5Z")
+13 if DGQ
QUIT
End DoDot:2
if DGQ
QUIT
+14 if DGQ
QUIT
End DoDot:1
if DGQ
QUIT
+15 if DGQ
QUIT
DSPLYNW ;
+1 if 45[$PIECE(DGSORT("DGMON"),U)
WRITE !
+2 WRITE !!,"New for "_DGMNAME,?26,"="
+3 IF 123[$PIECE(DGSORT("DGMON"),U)
WRITE $SELECT($GET(DGCNT("NEW"))>0:$JUSTIFY(DGCNT("NEW"),5),1:$JUSTIFY(0,5)),!
+4 IF '$TEST
WRITE $SELECT($GET(DGCNT("NEW",DGMON))>0:$JUSTIFY(DGCNT("NEW",DGMON),5),1:$JUSTIFY(0,5)),!
+5 if 123[$PIECE(DGSORT("DGMON"),U)
DO PAUSE^DGOTHRP2(.DGQ)
if DGQ
QUIT
+6 QUIT
+7 ;
PRNTOLD ;OTH-90 whose treatment carried/continued to the following month
+1 SET DGQRTR=""
FOR
SET DGQRTR=$ORDER(@DGLIST@("OLD",DGMON,DGQRTR))
if DGQRTR=""
QUIT
Begin DoDot:1
+2 SET DGPTNM=""
FOR
SET DGPTNM=$ORDER(@DGLIST@("OLD",DGMON,DGQRTR,DGPTNM))
if DGPTNM=""
QUIT
Begin DoDot:2
+3 SET DGCLCK=""
FOR
SET DGCLCK=$ORDER(@DGLIST@("OLD",DGMON,DGQRTR,DGPTNM,DGCLCK))
if DGCLCK=""
QUIT
Begin DoDot:3
+4 SET DGSTR=@DGLIST@("OLD",DGMON,DGQRTR,DGPTNM,DGCLCK)
+5 IF 45[$PIECE(DGSORT("DGMON"),U)
QUIT
+6 WRITE !
+7 IF $Y>(IOSL-4)
DO PAUSE^DGOTHRP2(.DGQ)
if DGQ
QUIT
DO HEAD
WRITE !
+8 ;patient name and PID
IF DGPTNM'=DGOLD
WRITE $EXTRACT(DGPTNM,1,20),?23,$PIECE(DGSTR,U,3)
+9 ;display the name and PID only once
SET DGOLD=DGPTNM
+10 WRITE ?31,$PIECE(DGSTR,U,2),?37,$$FMTE^XLFDT($PIECE(DGSTR,U,4),"5Z"),?49,$$FMTE^XLFDT($PIECE(DGSTR,U,5),"5Z")
+11 ;display N/A in replacement for days remaining if 90-Day has been inactivated
+12 WRITE ?61,$SELECT($PIECE(DGSTR,U,8)'="":$JUSTIFY("N/A",4),1:$JUSTIFY($PIECE(DGSTR,U,6),4))
End DoDot:3
if DGQ
QUIT
+13 if 123[$PIECE(DGSORT("DGMON"),U)
WRITE ?68,$$FMTE^XLFDT($PIECE(DGSTR,U,8),"5Z")
+14 if DGQ
QUIT
End DoDot:2
if DGQ
QUIT
+15 if DGQ
QUIT
End DoDot:1
if DGQ
QUIT
+16 if DGQ
QUIT
+17 WRITE !!
DSPLYCRY WRITE "Carryover for "_DGMNAME,?26,"="
+1 IF 123[$PIECE(DGSORT("DGMON"),U)
WRITE $SELECT($GET(DGCNT("OLD"))>0:$JUSTIFY(DGCNT("OLD"),5),1:$JUSTIFY(0,5)),!
+2 IF '$TEST
Begin DoDot:1
+3 WRITE $SELECT($GET(DGCNT("OLD",DGMON))>0:$JUSTIFY(DGCNT("OLD",DGMON),5),1:$JUSTIFY(0,5)),!
+4 WRITE "================================",!
+5 WRITE "TOTAL",?26," ",$JUSTIFY(($GET(DGCNT("NEW",DGMON)))+($GET(DGCNT("OLD",DGMON))),5),!
End DoDot:1
+6 DO PAUSE^DGOTHRP2(.DGQ)
if DGQ
QUIT
+7 QUIT
+8 ;
CALCIN(DGSTR,DGSTAT,DGMON) ;calculate inactivated OTH patients
+1 IF $PIECE(DGSTR,U,8)'=""
Begin DoDot:1
+2 IF 123[$PIECE(DGSORT("DGMON"),U)
Begin DoDot:2
+3 IF DGSTAT<1
SET DGCNT("OLD",$PIECE(DGSTR,U,2),0)=$GET(DGCNT("OLD",$PIECE(DGSTR,U,2),0))+1
+4 IF '$TEST
SET DGCNT("NEW",$PIECE(DGSTR,U,2),0)=$GET(DGCNT("NEW",$PIECE(DGSTR,U,2),0))+1
End DoDot:2
+5 IF 45[$PIECE(DGSORT("DGMON"),U)
SET DGCNT("IN",DGMON)=$GET(DGCNT("IN",DGMON))+1
End DoDot:1
+6 QUIT
+7 ;
MRPTSUM ;monthly report summary
+1 NEW TOTAL1,TOTAL2
+2 DO HEAD
+3 WRITE !,"REPORT SUMMARY for the month of ",$PIECE(DGSORT("DGMON"),U,2),":"
+4 WRITE !!,?16,"90-DAY",?29,"NEW",?39,"CARRY OVER",?55,"TOTAL",?64,"|",?65,"INACTIVATED"
+5 SET $PIECE(DGLN,"=",49)=""
WRITE !,?16,DGLN,?64,"|",?65,"============"
+6 NEW I,TOTAL
+7 SET (TOTAL1,TOTAL2)=0
+8 FOR I=1:1:5
Begin DoDot:1
+9 WRITE !,?16,$JUSTIFY(I,4)
+10 ;I $D(DGCNT("NEW",I))!($D(DGCNT("OLD",I))) D
+11 IF $DATA(DGCNT("NEW",I))
WRITE ?29,$JUSTIFY(DGCNT("NEW",I),3)
+12 IF $DATA(DGCNT("OLD",I))
WRITE ?39,$JUSTIFY(DGCNT("OLD",I),5)
+13 IF $DATA(DGCNT("NEW",I))!($DATA(DGCNT("OLD",I)))
WRITE ?55,$JUSTIFY($GET(DGCNT("NEW",I))+($GET(DGCNT("OLD",I))),5)
+14 IF '$TEST
WRITE ?55,$JUSTIFY(0,5)
+15 WRITE ?64,"|"
+16 IF $GET(DGCNT("NEW",I,0))!($GET(DGCNT("OLD",I,0)))
Begin DoDot:2
+17 WRITE ?65,$JUSTIFY($GET(DGCNT("NEW",I,0))+($GET(DGCNT("OLD",I,0))),6)
End DoDot:2
+18 SET TOTAL1=TOTAL1+($GET(DGCNT("NEW",I)))+($GET(DGCNT("OLD",I)))
+19 SET TOTAL2=TOTAL2+($GET(DGCNT("NEW",I,0)))+($GET(DGCNT("OLD",I,0)))
End DoDot:1
+20 SET $PIECE(DGLN,"=",65)=""
WRITE !,DGLN,?64,"|",?65,"============"
+21 WRITE !,"TOTAL",?29,$JUSTIFY($GET(DGCNT("NEW")),3),?39,$JUSTIFY($GET(DGCNT("OLD")),5),?55,$JUSTIFY($GET(TOTAL1),5),?64,"|",?65,$JUSTIFY($GET(TOTAL2),6)
+22 QUIT
+23 ;
MONAME ;Month Name
+1 ;;1^January
+2 ;;2^February
+3 ;;3^March
+4 ;;4^April
+5 ;;5^May
+6 ;;6^June
+7 ;;7^July
+8 ;;8^August
+9 ;;9^September
+10 ;;10^October
+11 ;;11^November
+12 ;;12^December
+13 QUIT
+14 ;
HEAD ;Print/Display Page Header Detail
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (ZTSTOP,DGQ)=1
QUIT
+2 NEW DGFACLTY,DGPRD
+3 IF TRM!('TRM&DGPAGE)
WRITE @IOF
+4 SET DGPAGE=$GET(DGPAGE)+1
+5 SET DGFACLTY="Facility: "_$PIECE(HERE,U,2)
+6 WRITE !,?80-$LENGTH(ZTDESC)\2,$GET(ZTDESC),?71,"Page:",?77,DGPAGE
+7 ;facility
WRITE !,?80-$LENGTH(DGFACLTY)\2,DGFACLTY
+8 SET DGPRD="Report Period: "_$SELECT(123[$PIECE(DGSORT("DGMON"),U):"Month of "_$PIECE(DGSORT("DGMON"),U,2),1:$PIECE(DGSORT("DGMON"),U,2))
+9 WRITE !,?80-$LENGTH(DGPRD)\2,DGPRD
+10 WRITE !,"Date Range:",?12,DGDTRNGE
+11 WRITE ?45,"Date Printed:",?59,$$FMTE^XLFDT($$NOW^XLFDT,"MP")
+12 WRITE !,DDASH
+13 WRITE !,"PATIENT NAME",?23,"PID",?29,"PERIOD",?37,"START DATE",?49,"END DATE",?61,"DAYS",?68,"INACTIVATION"
+14 WRITE !,?61,"LEFT",?68,"DATE"
+15 WRITE !,DDASH,!
+16 QUIT
+17 ;
SUBHEAD(DGSTAT,DGMNAME) ;display sub header
+1 WRITE !,$SELECT(DGSTAT:"OTH-90 Patients that started treatment in ",1:"Carry-over OTH-90 Patients for ")
+2 WRITE DGMNAME_":"
+3 WRITE !
+4 QUIT
+5 ;
HELP ;provide extended DIR("?") help text.
+1 ;
+2 IF X'="?"
IF X'="??"
WRITE !," Not a valid fiscal year.",!
+3 WRITE !," Enter the fiscal year in this format: YY or YYYY"
+4 QUIT
+5 ;
