DGPPRP4 ;LIB/MKN - PRESUMPTIVE PSYCHOSIS GENDER REPORT ;08/15/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 GENDER REPORT
N DFN,DGCAT,DGDIV,DGDT,DGDTDEF,DGDTF,DGDTT,DGHDRDT,DGI,DGSEX,DGSTD,DGTEMP,DGY,IEN3312,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("DGPPRP4",$J)) K @DGTEMP S (@DGTEMP@("F"),@DGTEMP@("M"))=0
; Allow queueing
K IOP,IO("Q") S %ZIS="MQ",%ZIS("B")="",POP=0 D ^%ZIS
Q:POP
I $D(IO("Q")) D Q ;Queued report settings
.S ZTDESC="Presumptive Psychosis Gender Report",ZTRTN="DQ^DGPPRP4"
.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 IEN3312=0 F S IEN3312=$O(^DGPP(33.1,"AC",DGDT,DGCAT,IEN3312)) Q:'IEN3312 D
... S DFN=$P(^DGPP(33.1,IEN3312,0),U),DGSEX=$$GET1^DIQ(2,DFN_",",.02,"I")
... S @DGTEMP@(0)=$G(@DGTEMP@(0))+1,@DGTEMP@(DGSEX)=$G(@DGTEMP@(DGSEX))+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 DGCAT,DGCATL,DGDASH,DGN,DGTOT,DGX,Y
S DGDASH="",$P(DGDASH,"-",81)=""
S DGX=$P(^DD(2,.5601,0),U,3)
S DGHDRDT="Date Range : "_$$FMTE^XLFDT(DGDTF)_" - "_$$FMTE^XLFDT(DGDTT)
W @IOF S DGX="Presumptive Psychosis Gender 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 !!,DGDASH
S (DGSEX,DGTOT)=0 F S DGSEX=$O(@DGTEMP@(DGSEX)) Q:DGSEX="" D
. S DGN=+$G(@DGTEMP@(DGSEX)) S DGTOT(DGSEX)=DGN,DGTOT=$G(DGTOT)+DGN
. W !,"TOTAL "_$S(DGSEX="F":"FEMALES",1:"MALES")_" REGISTERED UNDER PRESUMPTIVE PSYCHOSIS AUTHORITY",?66,": ",$J($FN(+DGN,","),7)
W !,DGDASH,!!,"TOTAL PATIENTS REGISTERED UNDER PRESUMPTIVE PSYCHOSIS AUTHORITY",?66,": ",$J($FN(DGTOT,","),7),!
W !,DGDASH,!!,"PERCENTAGE OF FEMALE",?21,": ",$S($G(DGTOT("F")):$J($FN($G(DGTOT("F"))*100/DGTOT,",",2),7),1:$J(0,7)),"%"
W !,"PERCENTAGE OF MALE",?21,": ",$S($G(DGTOT("M")):$J($FN($G(DGTOT("M"))*100/DGTOT,",",2),7),1:$J(0,7)),"%"
Q
;
SET ;
N DFNS,DGOUT
S DFNS=DFN_"," D GETS^DIQ(2,DFNS,".01;.0905",,"DGPAT")
S @DGTEMP@(DGDIV,DGCAT,DGDT,DFN,DGI)=$G(DGOUT(2,DFNS,.01))_U_$G(DGOUT(2,DFNS,.0905))_U_DGSTD
Q
;
OUT ; KILL RETURN ARRAY QUIT
D ^%ZISC
K @DGTEMP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPPRP4 3068 printed Sep 23, 2025@20:26:47 Page 2
DGPPRP4 ;LIB/MKN - PRESUMPTIVE PSYCHOSIS GENDER REPORT ;08/15/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 GENDER REPORT
+1 NEW DFN,DGCAT,DGDIV,DGDT,DGDTDEF,DGDTF,DGDTT,DGHDRDT,DGI,DGSEX,DGSTD,DGTEMP,DGY,IEN3312,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")
if +DGDT=0
QUIT
+3 SET DGDTF=$PIECE(DGDT,U,2)
SET DGDTT=$PIECE(DGDT,U,3)
+4 SET DGTEMP=$NAME(^TMP("DGPPRP4",$JOB))
KILL @DGTEMP
SET (@DGTEMP@("F"),@DGTEMP@("M"))=0
+5 ; Allow queueing
+6 KILL IOP,IO("Q")
SET %ZIS="MQ"
SET %ZIS("B")=""
SET POP=0
DO ^%ZIS
+7 if POP
QUIT
+8 ;Queued report settings
IF $DATA(IO("Q"))
Begin DoDot:1
+9 SET ZTDESC="Presumptive Psychosis Gender Report"
SET ZTRTN="DQ^DGPPRP4"
+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"
+2 FOR
SET DGDT=$ORDER(^DGPP(33.1,"AC",DGDT))
if 'DGDT!(DGDT>DGDTT)
QUIT
Begin DoDot:1
+3 SET DGCAT=""
FOR
SET DGCAT=$ORDER(^DGPP(33.1,"AC",DGDT,DGCAT))
if DGCAT=""
QUIT
Begin DoDot:2
+4 SET IEN3312=0
FOR
SET IEN3312=$ORDER(^DGPP(33.1,"AC",DGDT,DGCAT,IEN3312))
if 'IEN3312
QUIT
Begin DoDot:3
+5 SET DFN=$PIECE(^DGPP(33.1,IEN3312,0),U)
SET DGSEX=$$GET1^DIQ(2,DFN_",",.02,"I")
+6 SET @DGTEMP@(0)=$GET(@DGTEMP@(0))+1
SET @DGTEMP@(DGSEX)=$GET(@DGTEMP@(DGSEX))+1
End DoDot:3
End DoDot:2
End DoDot:1
+7 DO PRINT
DO OUT
+8 IF $EXTRACT(IOST,1,2)="C-"
READ !!?8,"End of the Report...Press Enter to Continue",X:DTIME
WRITE @IOF
+9 QUIT
+10 ;
PRINT ;Print out results
+1 NEW DGCAT,DGCATL,DGDASH,DGN,DGTOT,DGX,Y
+2 SET DGDASH=""
SET $PIECE(DGDASH,"-",81)=""
+3 SET DGX=$PIECE(^DD(2,.5601,0),U,3)
+4 SET DGHDRDT="Date Range : "_$$FMTE^XLFDT(DGDTF)_" - "_$$FMTE^XLFDT(DGDTT)
+5 WRITE @IOF
SET DGX="Presumptive Psychosis Gender Report"
WRITE $JUSTIFY(" ",80-$LENGTH(DGX)\2),DGX
+6 WRITE !,$JUSTIFY(" ",80-$LENGTH(DGHDRDT)\2),DGHDRDT,!
SET DGX="Date Report Printed: "
SET Y=DT
XECUTE ^DD("DD")
SET DGX=DGX_Y
WRITE $JUSTIFY(" ",80-$LENGTH(DGX)\2),DGX
+7 WRITE !!,DGDASH
+8 SET (DGSEX,DGTOT)=0
FOR
SET DGSEX=$ORDER(@DGTEMP@(DGSEX))
if DGSEX=""
QUIT
Begin DoDot:1
+9 SET DGN=+$GET(@DGTEMP@(DGSEX))
SET DGTOT(DGSEX)=DGN
SET DGTOT=$GET(DGTOT)+DGN
+10 WRITE !,"TOTAL "_$SELECT(DGSEX="F":"FEMALES",1:"MALES")_" REGISTERED UNDER PRESUMPTIVE PSYCHOSIS AUTHORITY",?66,": ",$JUSTIFY($FNUMBER(+DGN,","),7)
End DoDot:1
+11 WRITE !,DGDASH,!!,"TOTAL PATIENTS REGISTERED UNDER PRESUMPTIVE PSYCHOSIS AUTHORITY",?66,": ",$JUSTIFY($FNUMBER(DGTOT,","),7),!
+12 WRITE !,DGDASH,!!,"PERCENTAGE OF FEMALE",?21,": ",$SELECT($GET(DGTOT("F")):$JUSTIFY($FNUMBER($GET(DGTOT("F"))*100/DGTOT,",",2),7),1:$JUSTIFY(0,7)),"%"
+13 WRITE !,"PERCENTAGE OF MALE",?21,": ",$SELECT($GET(DGTOT("M")):$JUSTIFY($FNUMBER($GET(DGTOT("M"))*100/DGTOT,",",2),7),1:$JUSTIFY(0,7)),"%"
+14 QUIT
+15 ;
SET ;
+1 NEW DFNS,DGOUT
+2 SET DFNS=DFN_","
DO GETS^DIQ(2,DFNS,".01;.0905",,"DGPAT")
+3 SET @DGTEMP@(DGDIV,DGCAT,DGDT,DFN,DGI)=$GET(DGOUT(2,DFNS,.01))_U_$GET(DGOUT(2,DFNS,.0905))_U_DGSTD
+4 QUIT
+5 ;
OUT ; KILL RETURN ARRAY QUIT
+1 DO ^%ZISC
+2 KILL @DGTEMP
+3 QUIT
