DGPPRP2 ;LIB/MKN - PRESUMPTIVE PSYCHOSIS STATISTICAL REPORT ;08/02/2019
;;5.3;Registration;**977**August 02, 2019;;Build 177
;
;IA's
; 10004 Sup ^DIQ: $$GET1, GETS
; 10026 Sup ^DIR
; 10063 Sup ^%ZTLOAD
; 10086 Sup ^%ZIS: HOME
; 10089 Sup ^%ZISC
; 10103 Sup ^XLFDT: $$FMTE, $$FMADD
;
Q
;
EN ;entry point from Menu Option: PRESUMPTIVE PSYCHOSIS STATISTICAL REPORT
N DFN,DGCAT,DGDIV,DGDT,DGDTDEF,DGDTF,DGDTT,DGHDRDT,DGI,DGSTD,DGTEMP,DGY,IENDFN,POP,X,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
SELDATES ;
S DGDTDEF=$$GETDEFD^DGPPRP1() I DGDTDEF="" W !!,"There is no record of patch DG*5.3*977 being installed!",!! Q
S DGDT=$$DTFRMTO^DGPPRP1("Select dates")
Q:+DGDT=0
S DGDTF=$P(DGDT,U,2),DGDTT=$P(DGDT,U,3)
S DGTEMP=$NA(^TMP("DGPPRP2",$J)) K @DGTEMP
; Allow queueing
K IOP,IO("Q") S %ZIS="MQ",%ZIS("B")="" D ^%ZIS Q:POP
I $D(IO("Q")) D Q ;Queued report settings
.S ZTDESC="Presumptive Psychosis Statistical Report",ZTRTN="DQ^DGPPRP2"
.S ZTSAVE("DGRTYP")="",ZTSAVE("DGDTFRMT")="",ZTSAVE("DGDTFRM")="",ZTSAVE("ZTREQ")="@",ZTSAVE("DGDTTO")=""
.D ^%ZTLOAD,HOME^%ZIS
.I $G(ZTSK) W !!,"Report compilation has started with task# ",ZTSK,".",! S DIR(0)="E" D ^DIR K DIR
DQ ;
S DGDT=$$FMADD^XLFDT(DGDTF,-1)_".2399" F S DGDT=$O(^DGPP(33.1,"AC",DGDT)) Q:'DGDT!(DGDT>DGDTT) D
. S DGCAT="" F S DGCAT=$O(^DGPP(33.1,"AC",DGDT,DGCAT)) Q:DGCAT="" D
.. S IENDFN=0 F S IENDFN=$O(^DGPP(33.1,"AC",DGDT,DGCAT,IENDFN)) Q:'IENDFN D
... S DFN=$P($G(^DGPP(33.1,IENDFN,0)),U) Q:'DFN
... S @DGTEMP@(0)=$G(@DGTEMP@(0))+1,@DGTEMP@(DGCAT)=$G(@DGTEMP@(DGCAT))+1
D PRINT,OUT
I $E(IOST,1,2)="C-" R !!?8,"End of the Report...Press Enter to Continue",X:DTIME W @IOF
Q
;
PRINT ;Print out results
N DASH,DGCAT,DGCATL,DGX,Y
S DGX=$P(^DD(2,.5601,0),U,3),DASH="",$P(DASH,"-",81)=""
F DGI=1:1:$L(DGX,";")-1 S DGY=$P(DGX,";",DGI) S DGCATL($P(DGY,":"))=$P(DGY,":",2)
S DGHDRDT="Date Range: "_$$FMTE^XLFDT(DGDTF)_" - "_$$FMTE^XLFDT(DGDTT)
W @IOF D HELP
S DGX="Presumptive Psychosis Statistical Report" W !!,$J(" ",80-$L(DGX)\2),DGX
W !,$J(" ",80-$L(DGHDRDT)\2),DGHDRDT,! S DGX="Date Report Printed: " S Y=DT X ^DD("DD") S DGX=DGX_Y
W $J(" ",80-$L(DGX)\2),DGX
W !!,"Patients registered under different Presumptive Psychosis Categories",!,DASH
S DGCAT=0 F S DGCAT=$O(DGCATL(DGCAT)) Q:DGCAT="" D
. S DGX=DGCATL(DGCAT)
. S DGX=DGX_$J(" ",28-$L(DGX))_" : "_$J($FN(+$G(@DGTEMP@(DGCAT)),","),6) W !!,DGX
W !,DASH,!!,"TOTAL NUMBER OF PATIENTS REGISTERED UNDER PRESUMPTIVE PSYCHOSIS AUTHORITY: ",$FN(+$G(@DGTEMP@(0)),",")
W !! D HELP
Q
;
SET ;
N DFNS,DGOUT
S DFNS=DFN_"," D GETS^DIQ(2,DFNS,".01;.0905",,"DGOUT")
S @DGTEMP@(DGDIV,DGCAT,DGDT,DFN,DGI)=$G(DGOUT(2,DFNS,.01))_U_$G(DGOUT(2,DFNS,.0905))_U_DGSTD
Q
;
HELP ;
W "This report reflects the number of Veterans registered under Presumptive"
W !,"Psychosis authority, not necessarily treated."
Q
;
OUT ; KILL RETURN ARRAY QUIT
D ^%ZISC
K @DGTEMP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPPRP2 2973 printed Sep 23, 2025@20:26:46 Page 2
DGPPRP2 ;LIB/MKN - PRESUMPTIVE PSYCHOSIS STATISTICAL REPORT ;08/02/2019
+1 ;;5.3;Registration;**977**August 02, 2019;;Build 177
+2 ;
+3 ;IA's
+4 ; 10004 Sup ^DIQ: $$GET1, GETS
+5 ; 10026 Sup ^DIR
+6 ; 10063 Sup ^%ZTLOAD
+7 ; 10086 Sup ^%ZIS: HOME
+8 ; 10089 Sup ^%ZISC
+9 ; 10103 Sup ^XLFDT: $$FMTE, $$FMADD
+10 ;
+11 QUIT
+12 ;
EN ;entry point from Menu Option: PRESUMPTIVE PSYCHOSIS STATISTICAL REPORT
+1 NEW DFN,DGCAT,DGDIV,DGDT,DGDTDEF,DGDTF,DGDTT,DGHDRDT,DGI,DGSTD,DGTEMP,DGY,IENDFN,POP,X,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
SELDATES ;
+1 SET DGDTDEF=$$GETDEFD^DGPPRP1()
IF DGDTDEF=""
WRITE !!,"There is no record of patch DG*5.3*977 being installed!",!!
QUIT
+2 SET DGDT=$$DTFRMTO^DGPPRP1("Select dates")
+3 if +DGDT=0
QUIT
+4 SET DGDTF=$PIECE(DGDT,U,2)
SET DGDTT=$PIECE(DGDT,U,3)
+5 SET DGTEMP=$NAME(^TMP("DGPPRP2",$JOB))
KILL @DGTEMP
+6 ; Allow queueing
+7 KILL IOP,IO("Q")
SET %ZIS="MQ"
SET %ZIS("B")=""
DO ^%ZIS
if POP
QUIT
+8 ;Queued report settings
IF $DATA(IO("Q"))
Begin DoDot:1
+9 SET ZTDESC="Presumptive Psychosis Statistical Report"
SET ZTRTN="DQ^DGPPRP2"
+10 SET ZTSAVE("DGRTYP")=""
SET ZTSAVE("DGDTFRMT")=""
SET ZTSAVE("DGDTFRM")=""
SET ZTSAVE("ZTREQ")="@"
SET ZTSAVE("DGDTTO")=""
+11 DO ^%ZTLOAD
DO HOME^%ZIS
+12 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
DQ ;
+1 SET DGDT=$$FMADD^XLFDT(DGDTF,-1)_".2399"
FOR
SET DGDT=$ORDER(^DGPP(33.1,"AC",DGDT))
if 'DGDT!(DGDT>DGDTT)
QUIT
Begin DoDot:1
+2 SET DGCAT=""
FOR
SET DGCAT=$ORDER(^DGPP(33.1,"AC",DGDT,DGCAT))
if DGCAT=""
QUIT
Begin DoDot:2
+3 SET IENDFN=0
FOR
SET IENDFN=$ORDER(^DGPP(33.1,"AC",DGDT,DGCAT,IENDFN))
if 'IENDFN
QUIT
Begin DoDot:3
+4 SET DFN=$PIECE($GET(^DGPP(33.1,IENDFN,0)),U)
if 'DFN
QUIT
+5 SET @DGTEMP@(0)=$GET(@DGTEMP@(0))+1
SET @DGTEMP@(DGCAT)=$GET(@DGTEMP@(DGCAT))+1
End DoDot:3
End DoDot:2
End DoDot:1
+6 DO PRINT
DO OUT
+7 IF $EXTRACT(IOST,1,2)="C-"
READ !!?8,"End of the Report...Press Enter to Continue",X:DTIME
WRITE @IOF
+8 QUIT
+9 ;
PRINT ;Print out results
+1 NEW DASH,DGCAT,DGCATL,DGX,Y
+2 SET DGX=$PIECE(^DD(2,.5601,0),U,3)
SET DASH=""
SET $PIECE(DASH,"-",81)=""
+3 FOR DGI=1:1:$LENGTH(DGX,";")-1
SET DGY=$PIECE(DGX,";",DGI)
SET DGCATL($PIECE(DGY,":"))=$PIECE(DGY,":",2)
+4 SET DGHDRDT="Date Range: "_$$FMTE^XLFDT(DGDTF)_" - "_$$FMTE^XLFDT(DGDTT)
+5 WRITE @IOF
DO HELP
+6 SET DGX="Presumptive Psychosis Statistical Report"
WRITE !!,$JUSTIFY(" ",80-$LENGTH(DGX)\2),DGX
+7 WRITE !,$JUSTIFY(" ",80-$LENGTH(DGHDRDT)\2),DGHDRDT,!
SET DGX="Date Report Printed: "
SET Y=DT
XECUTE ^DD("DD")
SET DGX=DGX_Y
+8 WRITE $JUSTIFY(" ",80-$LENGTH(DGX)\2),DGX
+9 WRITE !!,"Patients registered under different Presumptive Psychosis Categories",!,DASH
+10 SET DGCAT=0
FOR
SET DGCAT=$ORDER(DGCATL(DGCAT))
if DGCAT=""
QUIT
Begin DoDot:1
+11 SET DGX=DGCATL(DGCAT)
+12 SET DGX=DGX_$JUSTIFY(" ",28-$LENGTH(DGX))_" : "_$JUSTIFY($FNUMBER(+$GET(@DGTEMP@(DGCAT)),","),6)
WRITE !!,DGX
End DoDot:1
+13 WRITE !,DASH,!!,"TOTAL NUMBER OF PATIENTS REGISTERED UNDER PRESUMPTIVE PSYCHOSIS AUTHORITY: ",$FNUMBER(+$GET(@DGTEMP@(0)),",")
+14 WRITE !!
DO HELP
+15 QUIT
+16 ;
SET ;
+1 NEW DFNS,DGOUT
+2 SET DFNS=DFN_","
DO GETS^DIQ(2,DFNS,".01;.0905",,"DGOUT")
+3 SET @DGTEMP@(DGDIV,DGCAT,DGDT,DFN,DGI)=$GET(DGOUT(2,DFNS,.01))_U_$GET(DGOUT(2,DFNS,.0905))_U_DGSTD
+4 QUIT
+5 ;
HELP ;
+1 WRITE "This report reflects the number of Veterans registered under Presumptive"
+2 WRITE !,"Psychosis authority, not necessarily treated."
+3 QUIT
+4 ;
OUT ; KILL RETURN ARRAY QUIT
+1 DO ^%ZISC
+2 KILL @DGTEMP
+3 QUIT
