DGOTHRP4 ;SLC/RM - OTH PATIENT PERIOD STATUS REPORT CONT. ;July 20, 2018@5:15
;;5.3;Registration;**952**;Aug 13, 1993;Build 160
;;Per VA Directive 6402, this routine should not be modified.
;
; Last Edited: SHRPE/RM - July 20, 2018 5: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
;
;- no direct entry
Q
;
CONT(DGSORT) ;Statistical Report continuation
N DGMON,DGQRTR,DGNWTOT,DGCRYTOT,DGINTOT,DGFYAR,DGCARY,DGLN
;quarterly report summary
I 4[$P(DGSORT("DGMON"),U) D
. D QRPTHD
. S DGMON="" F S DGMON=$O(DGSORT("DGMON",DGMON)) Q:DGMON="" D
. . D QRPTSUM
. D QRPTSUM1
;fiscal year report summary
I 5[$P(DGSORT("DGMON"),U) D
. N I,DGLN
. D QRPTHD
. S (DGQRTR,DGMON)=""
. W !
. S DGQRTR="" F S DGQRTR=$O(DGSORT("DGMON",DGQRTR)) Q:DGQRTR="" D
. . W !,"FY QUARTER ",DGQRTR,":"
. . S (DGNWTOT,DGCRYTOT,DGINTOT)=0
. . S DGMON="" F S DGMON=$O(DGSORT("DGMON",DGQRTR,DGMON)) Q:DGMON="" D
. . . D QRPTSUM
. . D QRPTSUM1
. . W !
. I $D(DGFYAR) D
. . W !!,"FISCAL YEAR OVER ALL SUMMARY:",!
. . F I=1:1:4 D
. . . W !,"FY QUARTER ",I
. . . W ?20,$J($P(DGFYAR(I),U),4),?30,$J($P(DGFYAR(I),U,2),6)
. . . W ?44,$J($P(DGFYAR(I),U,3),5),?69,$J($P(DGFYAR(I),U,4),6)
. . S $P(DGLN,"=",81)=""
. . W !,DGLN,"TOTAL INACTIVATED FOR THE YEAR:",?69,$J(DGCNT("IN"),6)
. . ;W !!,"TOTAL NUMBER OF UNIQUE PATIENTS TREATED FOR ",DGDTRNGE,": ",$J($G(DGNET),3)
Q
;
QRPTHD ;quarterly/fiscal report subheader
N DGLN
D HEAD^DGOTHRP3
W:5[$P(DGSORT("DGMON"),U) !,"TOTAL NUMBER OF UNIQUE PATIENTS TREATED FOR ",DGDTRNGE,": ",$J($G(DGNET),3)
W !!,"REPORT SUMMARY:" ;FOR ",DGDTRNGE,":"
W !!,"Month",?20,"New",?30,"Carry Over",?44,"TOTAL",?69,"INACTIVATED"
S $P(DGLN,"=",10)="" W !,DGLN,?20,"====",?30,DGLN,?44,"====="
S $P(DGLN,"=",12)="" W ?69,DGLN
Q
;
QRPTSUM ;quarterly report summary
N DGNEW,DGCARY
S DGNEW=$S($G(DGCNT("NEW",DGMON))>0:DGCNT("NEW",DGMON),1:0)
S DGCARY=$S($G(DGCNT("OLD",DGMON))>0:DGCNT("OLD",DGMON),1:0)
S DGNWTOT=$G(DGNWTOT)+$G(DGCNT("NEW",DGMON))
S DGCRYTOT=$G(DGCRYTOT)+$G(DGCNT("OLD",DGMON))
S DGINTOT=$G(DGINTOT)+$G(DGCNT("IN",DGMON))
W !
I 4[$P(DGSORT("DGMON"),U) W $P(DGSORT("DGMON",DGMON),U)
I 5[$P(DGSORT("DGMON"),U) W " ",$P(DGSORT("DGMON",DGQRTR,DGMON),U)
W ?20,$J(DGNEW,4),?30,$J(DGCARY,6),?44,$J(DGNEW+DGCARY,5),?69,$S($G(DGCNT("IN",DGMON))>0:$J(DGCNT("IN",DGMON),6),1:$J(0,6))
Q
;
QRPTSUM1 ;display grand total for quarterly/fiscal quarterly report summary
N DGLN
S $P(DGLN,"=",81)=""
W !,DGLN
W !,"TOTAL",?20,$J(DGNWTOT,4),?30,$J(DGCRYTOT,6)
W ?44,$S(4[$P(DGSORT("DGMON"),U):$J(DGCNT,5),1:$J($G(DGNWTOT)+$G(DGCRYTOT),5))
W ?69,$J(DGINTOT,6)
I 5[$P(DGSORT("DGMON"),U) D
. S DGFYAR(DGQRTR)=DGNWTOT_U_DGCRYTOT_U_($G(DGNWTOT)+$G(DGCRYTOT))_U_DGINTOT
. S DGCNT("IN")=$G(DGCNT("IN"))+DGINTOT
Q
;
PRINTFY(DGSORT,DGLIST,DGQRTR,DGMON,DGQ,DGMNAME) ;print/display carryover OTH patients
N DGSTAT,DGPTNM,DGCLCK,DGSTR,DGOLD
S DGSTAT="OLD",(DGOLD,DGPTNM,DGCLCK,DGSTR)=""
D HEAD^DGOTHRP3
W ! D SUBHEAD^DGOTHRP3(DGSTAT,DGMNAME)
F S DGPTNM=$O(@DGLIST@(DGSTAT,DGQRTR,DGMON,DGPTNM)) Q:DGPTNM="" D Q:DGQ
. F S DGCLCK=$O(@DGLIST@(DGSTAT,DGQRTR,DGMON,DGPTNM,DGCLCK)) Q:DGCLCK="" D Q:DGQ
. . S DGSTR=@DGLIST@(DGSTAT,DGQRTR,DGMON,DGPTNM,DGCLCK)
. . W !
. . I $Y>(IOSL-4) D PAUSE^DGOTHRP2(.DGQ) Q:DGQ D HEAD^DGOTHRP3 W !
. . I DGPTNM'=DGOLD D
. . . W $E(DGPTNM,1,20),?23,$P(DGSTR,U,3)
. . . 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")
. D CALCIN^DGOTHRP3(DGSTR,DGSTAT,DGMON) ;count inactivated OTH patients
. Q:DGQ
W !!
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGOTHRP4 4167 printed Nov 22, 2024@17:56:59 Page 2
DGOTHRP4 ;SLC/RM - OTH PATIENT PERIOD STATUS REPORT CONT. ;July 20, 2018@5:15
+1 ;;5.3;Registration;**952**;Aug 13, 1993;Build 160
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Last Edited: SHRPE/RM - July 20, 2018 5: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 ;- no direct entry
+18 QUIT
+19 ;
CONT(DGSORT) ;Statistical Report continuation
+1 NEW DGMON,DGQRTR,DGNWTOT,DGCRYTOT,DGINTOT,DGFYAR,DGCARY,DGLN
+2 ;quarterly report summary
+3 IF 4[$PIECE(DGSORT("DGMON"),U)
Begin DoDot:1
+4 DO QRPTHD
+5 SET DGMON=""
FOR
SET DGMON=$ORDER(DGSORT("DGMON",DGMON))
if DGMON=""
QUIT
Begin DoDot:2
+6 DO QRPTSUM
End DoDot:2
+7 DO QRPTSUM1
End DoDot:1
+8 ;fiscal year report summary
+9 IF 5[$PIECE(DGSORT("DGMON"),U)
Begin DoDot:1
+10 NEW I,DGLN
+11 DO QRPTHD
+12 SET (DGQRTR,DGMON)=""
+13 WRITE !
+14 SET DGQRTR=""
FOR
SET DGQRTR=$ORDER(DGSORT("DGMON",DGQRTR))
if DGQRTR=""
QUIT
Begin DoDot:2
+15 WRITE !,"FY QUARTER ",DGQRTR,":"
+16 SET (DGNWTOT,DGCRYTOT,DGINTOT)=0
+17 SET DGMON=""
FOR
SET DGMON=$ORDER(DGSORT("DGMON",DGQRTR,DGMON))
if DGMON=""
QUIT
Begin DoDot:3
+18 DO QRPTSUM
End DoDot:3
+19 DO QRPTSUM1
+20 WRITE !
End DoDot:2
+21 IF $DATA(DGFYAR)
Begin DoDot:2
+22 WRITE !!,"FISCAL YEAR OVER ALL SUMMARY:",!
+23 FOR I=1:1:4
Begin DoDot:3
+24 WRITE !,"FY QUARTER ",I
+25 WRITE ?20,$JUSTIFY($PIECE(DGFYAR(I),U),4),?30,$JUSTIFY($PIECE(DGFYAR(I),U,2),6)
+26 WRITE ?44,$JUSTIFY($PIECE(DGFYAR(I),U,3),5),?69,$JUSTIFY($PIECE(DGFYAR(I),U,4),6)
End DoDot:3
+27 SET $PIECE(DGLN,"=",81)=""
+28 WRITE !,DGLN,"TOTAL INACTIVATED FOR THE YEAR:",?69,$JUSTIFY(DGCNT("IN"),6)
+29 ;W !!,"TOTAL NUMBER OF UNIQUE PATIENTS TREATED FOR ",DGDTRNGE,": ",$J($G(DGNET),3)
End DoDot:2
End DoDot:1
+30 QUIT
+31 ;
QRPTHD ;quarterly/fiscal report subheader
+1 NEW DGLN
+2 DO HEAD^DGOTHRP3
+3 if 5[$PIECE(DGSORT("DGMON"),U)
WRITE !,"TOTAL NUMBER OF UNIQUE PATIENTS TREATED FOR ",DGDTRNGE,": ",$JUSTIFY($GET(DGNET),3)
+4 ;FOR ",DGDTRNGE,":"
WRITE !!,"REPORT SUMMARY:"
+5 WRITE !!,"Month",?20,"New",?30,"Carry Over",?44,"TOTAL",?69,"INACTIVATED"
+6 SET $PIECE(DGLN,"=",10)=""
WRITE !,DGLN,?20,"====",?30,DGLN,?44,"====="
+7 SET $PIECE(DGLN,"=",12)=""
WRITE ?69,DGLN
+8 QUIT
+9 ;
QRPTSUM ;quarterly report summary
+1 NEW DGNEW,DGCARY
+2 SET DGNEW=$SELECT($GET(DGCNT("NEW",DGMON))>0:DGCNT("NEW",DGMON),1:0)
+3 SET DGCARY=$SELECT($GET(DGCNT("OLD",DGMON))>0:DGCNT("OLD",DGMON),1:0)
+4 SET DGNWTOT=$GET(DGNWTOT)+$GET(DGCNT("NEW",DGMON))
+5 SET DGCRYTOT=$GET(DGCRYTOT)+$GET(DGCNT("OLD",DGMON))
+6 SET DGINTOT=$GET(DGINTOT)+$GET(DGCNT("IN",DGMON))
+7 WRITE !
+8 IF 4[$PIECE(DGSORT("DGMON"),U)
WRITE $PIECE(DGSORT("DGMON",DGMON),U)
+9 IF 5[$PIECE(DGSORT("DGMON"),U)
WRITE " ",$PIECE(DGSORT("DGMON",DGQRTR,DGMON),U)
+10 WRITE ?20,$JUSTIFY(DGNEW,4),?30,$JUSTIFY(DGCARY,6),?44,$JUSTIFY(DGNEW+DGCARY,5),?69,$SELECT($GET(DGCNT("IN",DGMON))>0:$JUSTIFY(DGCNT("IN",DGMON),6),1:$JUSTIFY(0,6))
+11 QUIT
+12 ;
QRPTSUM1 ;display grand total for quarterly/fiscal quarterly report summary
+1 NEW DGLN
+2 SET $PIECE(DGLN,"=",81)=""
+3 WRITE !,DGLN
+4 WRITE !,"TOTAL",?20,$JUSTIFY(DGNWTOT,4),?30,$JUSTIFY(DGCRYTOT,6)
+5 WRITE ?44,$SELECT(4[$PIECE(DGSORT("DGMON"),U):$JUSTIFY(DGCNT,5),1:$JUSTIFY($GET(DGNWTOT)+$GET(DGCRYTOT),5))
+6 WRITE ?69,$JUSTIFY(DGINTOT,6)
+7 IF 5[$PIECE(DGSORT("DGMON"),U)
Begin DoDot:1
+8 SET DGFYAR(DGQRTR)=DGNWTOT_U_DGCRYTOT_U_($GET(DGNWTOT)+$GET(DGCRYTOT))_U_DGINTOT
+9 SET DGCNT("IN")=$GET(DGCNT("IN"))+DGINTOT
End DoDot:1
+10 QUIT
+11 ;
PRINTFY(DGSORT,DGLIST,DGQRTR,DGMON,DGQ,DGMNAME) ;print/display carryover OTH patients
+1 NEW DGSTAT,DGPTNM,DGCLCK,DGSTR,DGOLD
+2 SET DGSTAT="OLD"
SET (DGOLD,DGPTNM,DGCLCK,DGSTR)=""
+3 DO HEAD^DGOTHRP3
+4 WRITE !
DO SUBHEAD^DGOTHRP3(DGSTAT,DGMNAME)
+5 FOR
SET DGPTNM=$ORDER(@DGLIST@(DGSTAT,DGQRTR,DGMON,DGPTNM))
if DGPTNM=""
QUIT
Begin DoDot:1
+6 FOR
SET DGCLCK=$ORDER(@DGLIST@(DGSTAT,DGQRTR,DGMON,DGPTNM,DGCLCK))
if DGCLCK=""
QUIT
Begin DoDot:2
+7 SET DGSTR=@DGLIST@(DGSTAT,DGQRTR,DGMON,DGPTNM,DGCLCK)
+8 WRITE !
+9 IF $Y>(IOSL-4)
DO PAUSE^DGOTHRP2(.DGQ)
if DGQ
QUIT
DO HEAD^DGOTHRP3
WRITE !
+10 IF DGPTNM'=DGOLD
Begin DoDot:3
+11 WRITE $EXTRACT(DGPTNM,1,20),?23,$PIECE(DGSTR,U,3)
+12 ;display the name and PID only once
SET DGOLD=DGPTNM
End DoDot:3
+13 WRITE ?31,$PIECE(DGSTR,U,2),?37,$$FMTE^XLFDT($PIECE(DGSTR,U,4),"5Z"),?49,$$FMTE^XLFDT($PIECE(DGSTR,U,5),"5Z")
+14 ;display N/A in replacement for days remaining if 90-Day has been inactivated
+15 WRITE ?61,$SELECT($PIECE(DGSTR,U,8)'="":$JUSTIFY("N/A",4),1:$JUSTIFY($PIECE(DGSTR,U,6),4))
End DoDot:2
if DGQ
QUIT
+16 WRITE ?68,$$FMTE^XLFDT($PIECE(DGSTR,U,8),"5Z")
+17 ;count inactivated OTH patients
DO CALCIN^DGOTHRP3(DGSTR,DGSTAT,DGMON)
+18 if DGQ
QUIT
End DoDot:1
if DGQ
QUIT
+19 WRITE !!
+20 QUIT
+21 ;
