DGPPRP5 ;LIB/MKN - PRESUMPTIVE PSYCHOSIS FISCAL YEAR REPORT ;08/15/2019
;;5.3;Registration;**977**August 02, 2019;;Build 177
;
;IA's
; 10003 Sup ^%DT
; 10004 Sup ^DIQ: $$GET1, GETS
; 10026 Sup ^DIR
; 10063 Sup ^%ZTLOAD
; 10086 Sup ^%ZIS: HOME
; 10089 Sup ^%ZISC
; 10103 Sup ^XLFDT: $$FMTE, $$FMADD
;
Q
;DGDTDEF
EN ;entry point from Menu Option: PRESUMPTIVE PSYCHOSIS FISCAL YEAR REPORT
N DFN,DGCAT,DGDEFDT,DGDIV,DGDT,DGDTDEF,DGDTF,DGDTT,DGDTYRS,DGFISCFR,DGFISCTO,DGFISCYR,DGFM,DGHDRDT,DGI,DGINC,DGMTH
N DGPER,DGQRT,DGSEX,DGSELQ,DGSELMN,DGTEMP,DGTF,DGX,DGY,EXIT,PAGE,POP,X,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS,%DT
SELFY ;Select Fiscal Year(s)
S DGDTYRS=$$GETFISC("Select Fiscal Years")
Q:+DGDTYRS=0
;S X="10/01/"_($P(DGDT,U,2)-1),%DT="" D ^%DT Q:Y=-1 S (DGDTF,DGSTD)=Y
;S X="09/30/"_$P(DGDT,U,3),%DT="" D ^%DT Q:Y=-1 S (DGDTT,DGEND)=Y
S DGFISCFR=$P(DGDTYRS,U,2),DGFISCTO=$P(DGDTYRS,U,3),PAGE=0
;
SELFYQ ;Select Quarters, or complete Fiscal Year
K DIR S DIR(0)="S^1:FY Quarter 1 (Oct-Nov-Dec);2:FY Quarter 2 (Jan-Feb-Mar);3:FY Quarter 3 (Apr-May-Jun);4:FY Quarter 4 (Jul-Aug-Sep);5:Fiscal Year (All Quarters)"
S DIR("A")="Select reporting period",DIR("B")=5 D ^DIR
Q:$D(DIRUT)
S DGSELQ=Y,EXIT=0 I DGSELQ=5 S DGSELM=4 D SETPER(.DGPER,DGDTYRS,5,"")
I DGSELQ<5 D Q:EXIT
. S DGX="1:October;2:November;3:December/1:January;2:February;3:March/1:April;2:May;3:June/1:July;2:August;3:September",DGX=$P(DGX,"/",DGSELQ)
. K DIR S DIR(0)="S^"_DGX_";4:All Months in the Quarter"
. S DIR("A")="Select the month of the Quarter or All",DIR("B")=4
. D ^DIR S:$D(DIRUT) EXIT=1
. S DGSELM=Y,DGX=$P($P(DGX,";",DGSELM),":",2),DGSELMN=$$GETMTH(DGX)
. D SETPER(.DGPER,DGDTYRS,DGSELQ,Y)
S DGTEMP=$NA(^TMP("DGPPRP5",$J)) K @DGTEMP
;Initialize zero counts for MALE and FEMALE
S DGYR="" F S DGYR=$O(DGPER(DGYR)) Q:DGYR="" D
. S DGDT1="" F S DGDT1=$O(DGPER(DGYR,DGDT1)) Q:DGDT1="" D
.. S DGDT2="" F S DGDT2=$O(DGPER(DGYR,DGDT1,DGDT2)) Q:DGDT2="" D
... S DGQRT=DGPER(DGYR,DGDT1,DGDT2)
... F DGMTH=+$E(DGDT1,4,5):1:+$E(DGDT2,4,5) F DGFM="F","M" S @DGTEMP@(DGYR,DGQRT,DGMTH,DGFM)=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 Fiscal Year Report",ZTRTN="DQ^DGPPRP5"
.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,".",! K DIR S DIR(0)="E" D ^DIR K DIR
DQ ;
N DGQSEL,DGYR,DGDT1,DGDT2,EN3312
S DGYR="" F S DGYR=$O(DGPER(DGYR)) Q:DGYR="" D
. S DGDT1="" F S DGDT1=$O(DGPER(DGYR,DGDT1)) Q:DGDT1="" D
.. S DGDT2="" F S DGDT2=$O(DGPER(DGYR,DGDT1,DGDT2)) Q:DGDT2="" D DQ1
D PRINT,OUT
Q
;
DQ1 ;
N DGDT,IEN331
S DGDT=$$FMADD^XLFDT(DGDT1,-1)_".2399"
F S DGDT=$O(^DGPP(33.1,"AC",DGDT)) Q:'DGDT!(DGDT>DGDT2) D
. S DGMTH=+$$FMTE^XLFDT(DGDT,"5PZ"),DGQRT=$$GETQUART(DGMTH)
. S DGCAT="" F S DGCAT=$O(^DGPP(33.1,"AC",DGDT,DGCAT)) Q:DGCAT="" D
.. S IEN331=0 F S IEN331=$O(^DGPP(33.1,"AC",DGDT,DGCAT,IEN331)) Q:'IEN331 D
... S DFN=$$GET1^DIQ(33.1,IEN331_",",.01,"I") Q:'DFN
... S DGSEX=$$GET1^DIQ(2,DFN_",",.02,"I") Q:DGSEX=""
... S @DGTEMP@(0)=$G(@DGTEMP@(0))+1 ;,@DGTEMP@(DGYR)=DGDT1_U_DGDT2
... S @DGTEMP@(DGYR,DGQRT,DGMTH,DGSEX)=$G(@DGTEMP@(DGYR,DGQRT,DGMTH,DGSEX))+1
Q
;
FMYR(YR) ;
Q ($E(YR,1,2)-18+1)_$E(YR,3,4)
;
GETQM(YR,QRT,MTH) ;
N QRT1,Y
I MTH="" Q $S(QRT=1:"1001^1231",QRT=2:"0101^0331",QRT=3:"0401^0630",1:"0701^0930")
S QRT1=$S(QRT=1:"1001^1031/1101^1130/1201^1231/",QRT=2:"0101^0131/0201^0228/0301^0331",QRT=3:"0401^0430/0501^0531/0601^0630",1:"0701^0731/0801^0831/0901^0930")
I MTH<4 S QRT1=$P(QRT1,"/",MTH) D Q QRT1
. I QRT1?1"0201".E I (YR/4)=(YR\4) S $P(QRT1,U,2)="0229"
;MTH is 4 = All months
S QRT1=$P(QRT1,U)_U_$P(QRT1,U,$L(QRT1,U))
Q QRT1
;
SETPER(DGPER,DGYRS,DGQRT,DGMTH) ;
;DGYRS="1^YYYY^YYYY" Ex: "1^2018^2019"
;DGQRT=5 All quarters (DGMTH will be "")
;DGQRT<5 A specific quarter
;DGMTH=1-3 A calendar month Ex: Quarter 4 Month 1=July
;DGMTH=4 All months in the quarter
N DGM1,DGM2,DGQ,DGQRT1,DGQRT2,DGX,DGY,DGY1
S:DGQRT=5 DGQRT1=1,DGQRT2=4 S:DGQRT<5 (DGQRT1,DGQRT2)=DGQRT
F DGY=$P(DGYRS,U,2):1:$P(DGYRS,U,3) D
. ;get fiscal yr 3181010^3181231, 3190101^3190331, etc
. F DGQ=DGQRT1:1:DGQRT2 D
.. S DGY1=$$FMYR(DGY) S:DGQ=1 DGY1=$$FMYR(DGY)-1
.. S DGX=$$GETQM(DGY,DGQ,DGMTH)
.. S DGPER(DGY,DGY1_$P(DGX,U),DGY1_$P(DGX,U,2))=DGQ Q
Q
;
PRINT ;Print out results
N DGCAT,DGCATL,DGDASH,DGDASH2,DGF,DGHDR,DGM,DGMF,DGMM,DGMTH,DGMTHC,DGN,DGQRT,DGQRTTF,DGQRTTM,DGTTF,DGTM,DGYRTF,DGYRTM
N DGTOT,DGX,DGYR,EXIT,Y
S DGDASH="",$P(DGDASH,"-",81)="",DGDASH2="",$P(DGDASH2,"=",81)="",DGTOT=0
I '$D(@DGTEMP) W !!,"No patients found for the selected criteria" Q
S EXIT=0
S (DGTF,DGTM,DGYR)=0 F S DGYR=$O(@DGTEMP@(DGYR)) Q:'DGYR!(EXIT) D
. S (DGHDR,DGYRTF,DGYRTM)=0
. S (DGQRT,DGQRTTF,DGQRTTM)=0 F DGQRT=1:1:4 D:$D(@DGTEMP@(DGYR,DGQRT))
.. I 'DGHDR D HDR
.. S DGMTH=0 F S DGMTH=$O(@DGTEMP@(DGYR,DGQRT,DGMTH)) Q:'DGMTH!(EXIT) D
... S EXIT=$$CHKPGHDR(1) Q:EXIT ;Check $Y
... S DGMTHC=$P("January/February/March/April/May/June/July/August/September/October/November/December/","/",DGMTH)
... I DGSELQ=5,"/1/4/7/10/"[("/"_DGMTH_"/") D PRINT2 Q:EXIT
... S DGM=$G(@DGTEMP@(DGYR,DGQRT,DGMTH,"M")),DGF=$G(@DGTEMP@(DGYR,DGQRT,DGMTH,"F"))
... I DGM S DGTM=DGTM+DGM,DGYRTM=DGYRTM+DGM,DGQRTTM=DGQRTTM+DGM,DGTOT=DGTOT+DGM
... I DGF S DGTF=DGTF+DGF,DGYRTF=DGYRTF+DGF,DGQRTTF=DGQRTTF+DGF,DGTOT=DGTOT+DGF
... W !,DGMTHC,?10,$J($FN(DGM,","),10),?22,$J($FN(DGF,","),10)
... W ?36,$J($FN(DGM+DGF,","),10)
.. Q:EXIT
.. S EXIT=$$CHKPGHDR(2) Q:EXIT ;Check $Y
.. W !,DGDASH,!,"TOTAL",?10,$J($FN(DGQRTTM,","),10),?22,$J($FN(DGQRTTF,","),10),?36,$J($FN(DGQRTTM+DGQRTTF,","),10)
. Q:EXIT
. S EXIT=$$CHKPGHDR(3) Q:EXIT ;Check $Y
. ;Now print Fiscal Year Quarterly summary
. W !!,"FISCAL YEAR OVERALL SUMMARY:",!?15,$J("MALE",10),?27,$J("FEMALE",10),?41,$J("TOTAL",10)
. S (DGQRT,EXIT)=0 F S DGQRT=$O(@DGTEMP@(DGYR,DGQRT)) Q:'DGQRT!(EXIT) D
.. S EXIT=$$CHKPGHDR(1,5,1) Q:EXIT ;Check $Y
.. S DGM="",(DGMF,DGMM)=0 F S DGM=$O(@DGTEMP@(DGYR,DGQRT,DGM)) Q:DGM="" D
... S DGMF=DGMF+$G(@DGTEMP@(DGYR,DGQRT,DGM,"F")),DGMM=DGMM+$G(@DGTEMP@(DGYR,DGQRT,DGM,"M"))
.. W !,DGYR," QUARTER ",DGQRT,?15,$J($FN(DGMM,","),10),?27,$J($FN(DGMF,","),10),?41,$J($FN(DGMM+DGMF,","),10)
. ;End of Fiscal Year numbers
. S EXIT=$$CHKPGHDR(3,5,1) Q:EXIT ;Check $Y
. W !,DGDASH2,!!,"TOTAL PATIENTS REGISTERED FOR THE YEAR: ",?41,$J($FN(DGYRTM+DGYRTF,","),10)
. I ($G(IOM)<132)&($E(IOST,1,2)="C-")&(IO=IO(0)) W ! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S EXIT=1
W:'EXIT !!,"TOTAL PATIENTS REGISTERED: ",?41,$J($FN(DGTOT,","),10)
I $E(IOST,1,2)="C-",'EXIT R !!?8,"End of the Report...Press Enter to Continue",X:DTIME W @IOF
;
Q
;
PRINT2 ;
S EXIT=$$CHKPGHDR(3) ;Check $Y
Q:EXIT
W !!,DGYR," QUARTER ",$$GETQUART(DGMTH),!
Q
;
CHKPGHDR(LINES,OFFSET,INHIB) ;Check if Page Header needs printing
N DIRYT,EXIT
S EXIT=0,OFFSET=+$G(OFFSET),INHIB=+$G(INHIB)
I $Y+LINES>IOSL I ($E(IOST,1,2)="C-")&(IO=IO(0)) K DIR S DIR(0)="E" D ^DIR K DIR D Q:EXIT 1
. I $D(DIRUT) S EXIT=1 Q
. D HDR(OFFSET,INHIB)
Q EXIT
;
HDR(OFFSET,INHIB) ;
N DGM,DGDT1,DGDT2
S DGM=$G(@DGTEMP@(DGYR))
S OFFSET=+$G(OFFSET),INHIB=+$G(INHIB)
S DGX=$P(^DD(2,.5601,0),U,3),DGDASH="",$P(DGDASH,"-",81)=""
S DGDT1=$O(DGPER(DGYR,"")),DGDT2=$O(DGPER(DGYR,""),-1),DGDT2=$O(DGPER(DGYR,DGDT2,""))
S DGHDRDT="Date Range : "_$$FMTE^XLFDT(DGDT1,"5PZ")_" - "_$$FMTE^XLFDT(DGDT2,"5PZ")
W @IOF S DGX="Presumptive Psychosis Fiscal Year Report" W $J(" ",80-$L(DGX)\2),DGX
S DGX="Report Period: "_$S(DGSELQ=5:"Fiscal Year (All Quarters)",1:"Quarter: "_DGSELQ_" "_$$WHICHMTH(DGSELQ,DGSELM)) W !,$J(" ",80-$L(DGX)\2),DGX
W !,$J(" ",80-$L(DGHDRDT)\2),DGHDRDT ;Date Range
S DGX="Date Report Printed: " S Y=DT X ^DD("DD") S DGX=DGX_Y W !,$J(" ",80-$L(DGX)\2),DGX
S PAGE=PAGE+1
W ?68,"Page: "_PAGE
W:'INHIB !,DGDASH,!,"MONTH",?10+OFFSET,$J("MALE",10),?22+OFFSET,$J("FEMALE",10),?36+OFFSET,$J("TOTAL",10),!,DGDASH
S DGHDR=1
Q
;
WHICHMTH(DGSELQ,DGSELM) ;Heading shows All Months or just the one month
N DGX
I DGSELM=4 Q "All Months"
S DGX=$$GETMTHS(DGSELQ)
Q $P($P(DGX,";",DGSELM),":",2)
;
FY(DATE) ; return a dates Fiscal Year
N YR,FY,MTH,QRT
I $G(DATE)?7N.E S YR=$S($E(DATE,4,5)<10:$E(DATE,1,3),1:$E(DATE,1,3)+1),FY=$E(YR,2,3)
S MTH=$E(DATE,4,5),QRT=$S(MTH<4:2,MTH>3&(MTH<7):3,MTH>6&(MTH<10):4,1:1)
Q (($E(DATE)-1*1000)+FY)_"Q"_QRT
;
GETFISC(PROMPT) ;Get from and to Fiscal Years
N DGDEFDA,DGDEFFY,DGDTFRM,DGDTTO,DGFIRST,DTOUT,OUT,DIRUT,Y
;INPUT ; PROMPT - Message to display prior to prompting for dates
;OUTPUT: 1^BEGDT^ENDDT - Data found
; 0 - User up arrowed or timed out
;If they want to show first available date for that set of Status, use this sub
FRMYR ;
W !
;S OUT=0,DGDTDEF=$$GETDEFD^DGPPRP1() I DGDTDEF="" W !!,"There is no record of patch DG*5.3*977 being installed!",!! Q
S OUT=0,DGDTDEF=3190101
S DGFIRST=$P($$FY(DGDTDEF),"Q")
S DGDEFFY=$P($$FY(DT),"Q")
K DIR S DIR(0)="N^"_DGFIRST_":"_DGDEFFY,DIR("A")="Enter 'From' Fiscal Year",DIR("B")=DGFIRST D ^DIR
Q:$D(DIRUT) 0
S DGDTFRM=+Y
TOYR ;
;I DGDTFRM=DGDEFFY Q 1_U_DGDTFRM_U_DGDTFRM
K DIR S DIR(0)="N^"_DGDTFRM_":"_DGDEFFY,DIR("A")="Enter 'To' Fiscal Year",DIR("B")=DGDEFFY D ^DIR
Q:$D(DIRUT) 0 ;G:$D(DIRUT) FRMYR
S DGDTTO=+Y,OUT=1_U_DGDTFRM_U_DGDTTO
Q OUT
;T
;
INITTEMP(DGFISCFR,DGFISCTO,DGSELQ,DGSELM) ;
N DGI,DGMTHFR,DGMTHTO,DGSEX,DGX,DGYR
S:DGSELQ=5 DGMTHFR=1,DGMTHTO=12
D:DGSELQ<5
. S DGX=$$GETMTHSN(DGSELQ)
. I DGSELM=4 S DGMTHFR=$P($P(DGX,";"),":",2),DGMTHTO=$P($P(DGX,";",3),":",2)
. I DGSELM<4 S (DGMTHFR,DGMTHTO)=$P($P(DGX,";",DGSELM),":",2)
F DGYR=DGFISCFR:1:DGFISCTO F DGI=DGMTHFR:1:DGMTHTO F DGSEX="F","M" S @DGTEMP@(DGYR,$$GETQUART(DGI),DGI,DGSEX)=0
Q
;
GETMTH(D) ;
Q $S(D="January":1,D="February":2,D="March":3,D="April":4,D="May":5,D="June":6,D="July":7,D="August":8,D="September":9,D="October":10,D="November":11,1:"December")
;
GETQUART(MTH) ;
Q $P("2/2/2/3/3/3/4/4/4/1/1/1/","/",MTH)
;
GETMTHQ(MTH) ;
Q $P("2/2/2/3/3/3/4/4/4/1/1/1/","/",MTH)
;
GETMTHS(DGSELQ) ;
S DGX="1:October;2:November;3:December/1:January;2:February;3:March/1:April;2:May;3:June/1:July;2:August;3:September"
Q $P(DGX,"/",DGSELQ)
;
GETMTHSN(DGSELQ) ;
S DGX="1:10;2:11;3:12/1:1;2:2;3:3/1:4;2:5;3:6/1:7;2:8;3:9"
Q $P(DGX,"/",DGSELQ)
;
OUT ; KILL RETURN ARRAY QUIT
D ^%ZISC
K @DGTEMP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPPRP5 10750 printed Dec 13, 2024@02:50:56 Page 2
DGPPRP5 ;LIB/MKN - PRESUMPTIVE PSYCHOSIS FISCAL YEAR REPORT ;08/15/2019
+1 ;;5.3;Registration;**977**August 02, 2019;;Build 177
+2 ;
+3 ;IA's
+4 ; 10003 Sup ^%DT
+5 ; 10004 Sup ^DIQ: $$GET1, GETS
+6 ; 10026 Sup ^DIR
+7 ; 10063 Sup ^%ZTLOAD
+8 ; 10086 Sup ^%ZIS: HOME
+9 ; 10089 Sup ^%ZISC
+10 ; 10103 Sup ^XLFDT: $$FMTE, $$FMADD
+11 ;
+12 QUIT
+13 ;DGDTDEF
EN ;entry point from Menu Option: PRESUMPTIVE PSYCHOSIS FISCAL YEAR REPORT
+1 NEW DFN,DGCAT,DGDEFDT,DGDIV,DGDT,DGDTDEF,DGDTF,DGDTT,DGDTYRS,DGFISCFR,DGFISCTO,DGFISCYR,DGFM,DGHDRDT,DGI,DGINC,DGMTH
+2 NEW DGPER,DGQRT,DGSEX,DGSELQ,DGSELMN,DGTEMP,DGTF,DGX,DGY,EXIT,PAGE,POP,X,ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS,%DT
SELFY ;Select Fiscal Year(s)
+1 SET DGDTYRS=$$GETFISC("Select Fiscal Years")
+2 if +DGDTYRS=0
QUIT
+3 ;S X="10/01/"_($P(DGDT,U,2)-1),%DT="" D ^%DT Q:Y=-1 S (DGDTF,DGSTD)=Y
+4 ;S X="09/30/"_$P(DGDT,U,3),%DT="" D ^%DT Q:Y=-1 S (DGDTT,DGEND)=Y
+5 SET DGFISCFR=$PIECE(DGDTYRS,U,2)
SET DGFISCTO=$PIECE(DGDTYRS,U,3)
SET PAGE=0
+6 ;
SELFYQ ;Select Quarters, or complete Fiscal Year
+1 KILL DIR
SET DIR(0)="S^1:FY Quarter 1 (Oct-Nov-Dec);2:FY Quarter 2 (Jan-Feb-Mar);3:FY Quarter 3 (Apr-May-Jun);4:FY Quarter 4 (Jul-Aug-Sep);5:Fiscal Year (All Quarters)"
+2 SET DIR("A")="Select reporting period"
SET DIR("B")=5
DO ^DIR
+3 if $DATA(DIRUT)
QUIT
+4 SET DGSELQ=Y
SET EXIT=0
IF DGSELQ=5
SET DGSELM=4
DO SETPER(.DGPER,DGDTYRS,5,"")
+5 IF DGSELQ<5
Begin DoDot:1
+6 SET DGX="1:October;2:November;3:December/1:January;2:February;3:March/1:April;2:May;3:June/1:July;2:August;3:September"
SET DGX=$PIECE(DGX,"/",DGSELQ)
+7 KILL DIR
SET DIR(0)="S^"_DGX_";4:All Months in the Quarter"
+8 SET DIR("A")="Select the month of the Quarter or All"
SET DIR("B")=4
+9 DO ^DIR
if $DATA(DIRUT)
SET EXIT=1
+10 SET DGSELM=Y
SET DGX=$PIECE($PIECE(DGX,";",DGSELM),":",2)
SET DGSELMN=$$GETMTH(DGX)
+11 DO SETPER(.DGPER,DGDTYRS,DGSELQ,Y)
End DoDot:1
if EXIT
QUIT
+12 SET DGTEMP=$NAME(^TMP("DGPPRP5",$JOB))
KILL @DGTEMP
+13 ;Initialize zero counts for MALE and FEMALE
+14 SET DGYR=""
FOR
SET DGYR=$ORDER(DGPER(DGYR))
if DGYR=""
QUIT
Begin DoDot:1
+15 SET DGDT1=""
FOR
SET DGDT1=$ORDER(DGPER(DGYR,DGDT1))
if DGDT1=""
QUIT
Begin DoDot:2
+16 SET DGDT2=""
FOR
SET DGDT2=$ORDER(DGPER(DGYR,DGDT1,DGDT2))
if DGDT2=""
QUIT
Begin DoDot:3
+17 SET DGQRT=DGPER(DGYR,DGDT1,DGDT2)
+18 FOR DGMTH=+$EXTRACT(DGDT1,4,5):1:+$EXTRACT(DGDT2,4,5)
FOR DGFM="F","M"
SET @DGTEMP@(DGYR,DGQRT,DGMTH,DGFM)=0
End DoDot:3
End DoDot:2
End DoDot:1
+19 ; Allow queueing
+20 KILL IOP,IO("Q")
SET %ZIS="MQ"
SET %ZIS("B")=""
SET POP=0
DO ^%ZIS
+21 if POP
QUIT
+22 ;Queued report settings
IF $DATA(IO("Q"))
Begin DoDot:1
+23 SET ZTDESC="Presumptive Psychosis Fiscal Year Report"
SET ZTRTN="DQ^DGPPRP5"
+24 SET ZTSAVE("DGRTYP")=""
SET ZTSAVE("DGDTFRMT")=""
SET ZTSAVE("DGDTFRM")=""
SET ZTSAVE("ZTREQ")="@"
SET ZTSAVE("DGDTTO")=""
+25 DO ^%ZTLOAD
DO HOME^%ZIS
+26 IF $GET(ZTSK)
WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
DQ ;
+1 NEW DGQSEL,DGYR,DGDT1,DGDT2,EN3312
+2 SET DGYR=""
FOR
SET DGYR=$ORDER(DGPER(DGYR))
if DGYR=""
QUIT
Begin DoDot:1
+3 SET DGDT1=""
FOR
SET DGDT1=$ORDER(DGPER(DGYR,DGDT1))
if DGDT1=""
QUIT
Begin DoDot:2
+4 SET DGDT2=""
FOR
SET DGDT2=$ORDER(DGPER(DGYR,DGDT1,DGDT2))
if DGDT2=""
QUIT
DO DQ1
End DoDot:2
End DoDot:1
+5 DO PRINT
DO OUT
+6 QUIT
+7 ;
DQ1 ;
+1 NEW DGDT,IEN331
+2 SET DGDT=$$FMADD^XLFDT(DGDT1,-1)_".2399"
+3 FOR
SET DGDT=$ORDER(^DGPP(33.1,"AC",DGDT))
if 'DGDT!(DGDT>DGDT2)
QUIT
Begin DoDot:1
+4 SET DGMTH=+$$FMTE^XLFDT(DGDT,"5PZ")
SET DGQRT=$$GETQUART(DGMTH)
+5 SET DGCAT=""
FOR
SET DGCAT=$ORDER(^DGPP(33.1,"AC",DGDT,DGCAT))
if DGCAT=""
QUIT
Begin DoDot:2
+6 SET IEN331=0
FOR
SET IEN331=$ORDER(^DGPP(33.1,"AC",DGDT,DGCAT,IEN331))
if 'IEN331
QUIT
Begin DoDot:3
+7 SET DFN=$$GET1^DIQ(33.1,IEN331_",",.01,"I")
if 'DFN
QUIT
+8 SET DGSEX=$$GET1^DIQ(2,DFN_",",.02,"I")
if DGSEX=""
QUIT
+9 ;,@DGTEMP@(DGYR)=DGDT1_U_DGDT2
SET @DGTEMP@(0)=$GET(@DGTEMP@(0))+1
+10 SET @DGTEMP@(DGYR,DGQRT,DGMTH,DGSEX)=$GET(@DGTEMP@(DGYR,DGQRT,DGMTH,DGSEX))+1
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
FMYR(YR) ;
+1 QUIT ($EXTRACT(YR,1,2)-18+1)_$EXTRACT(YR,3,4)
+2 ;
GETQM(YR,QRT,MTH) ;
+1 NEW QRT1,Y
+2 IF MTH=""
QUIT $SELECT(QRT=1:"1001^1231",QRT=2:"0101^0331",QRT=3:"0401^0630",1:"0701^0930")
+3 SET QRT1=$SELECT(QRT=1:"1001^1031/1101^1130/1201^1231/",QRT=2:"0101^0131/0201^0228/0301^0331",QRT=3:"0401^0430/0501^0531/0601^0630",1:"0701^0731/0801^0831/0901^0930")
+4 IF MTH<4
SET QRT1=$PIECE(QRT1,"/",MTH)
Begin DoDot:1
+5 IF QRT1?1"0201".E
IF (YR/4)=(YR\4)
SET $PIECE(QRT1,U,2)="0229"
End DoDot:1
QUIT QRT1
+6 ;MTH is 4 = All months
+7 SET QRT1=$PIECE(QRT1,U)_U_$PIECE(QRT1,U,$LENGTH(QRT1,U))
+8 QUIT QRT1
+9 ;
SETPER(DGPER,DGYRS,DGQRT,DGMTH) ;
+1 ;DGYRS="1^YYYY^YYYY" Ex: "1^2018^2019"
+2 ;DGQRT=5 All quarters (DGMTH will be "")
+3 ;DGQRT<5 A specific quarter
+4 ;DGMTH=1-3 A calendar month Ex: Quarter 4 Month 1=July
+5 ;DGMTH=4 All months in the quarter
+6 NEW DGM1,DGM2,DGQ,DGQRT1,DGQRT2,DGX,DGY,DGY1
+7 if DGQRT=5
SET DGQRT1=1
SET DGQRT2=4
if DGQRT<5
SET (DGQRT1,DGQRT2)=DGQRT
+8 FOR DGY=$PIECE(DGYRS,U,2):1:$PIECE(DGYRS,U,3)
Begin DoDot:1
+9 ;get fiscal yr 3181010^3181231, 3190101^3190331, etc
+10 FOR DGQ=DGQRT1:1:DGQRT2
Begin DoDot:2
+11 SET DGY1=$$FMYR(DGY)
if DGQ=1
SET DGY1=$$FMYR(DGY)-1
+12 SET DGX=$$GETQM(DGY,DGQ,DGMTH)
+13 SET DGPER(DGY,DGY1_$PIECE(DGX,U),DGY1_$PIECE(DGX,U,2))=DGQ
QUIT
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
PRINT ;Print out results
+1 NEW DGCAT,DGCATL,DGDASH,DGDASH2,DGF,DGHDR,DGM,DGMF,DGMM,DGMTH,DGMTHC,DGN,DGQRT,DGQRTTF,DGQRTTM,DGTTF,DGTM,DGYRTF,DGYRTM
+2 NEW DGTOT,DGX,DGYR,EXIT,Y
+3 SET DGDASH=""
SET $PIECE(DGDASH,"-",81)=""
SET DGDASH2=""
SET $PIECE(DGDASH2,"=",81)=""
SET DGTOT=0
+4 IF '$DATA(@DGTEMP)
WRITE !!,"No patients found for the selected criteria"
QUIT
+5 SET EXIT=0
+6 SET (DGTF,DGTM,DGYR)=0
FOR
SET DGYR=$ORDER(@DGTEMP@(DGYR))
if 'DGYR!(EXIT)
QUIT
Begin DoDot:1
+7 SET (DGHDR,DGYRTF,DGYRTM)=0
+8 SET (DGQRT,DGQRTTF,DGQRTTM)=0
FOR DGQRT=1:1:4
if $DATA(@DGTEMP@(DGYR,DGQRT))
Begin DoDot:2
+9 IF 'DGHDR
DO HDR
+10 SET DGMTH=0
FOR
SET DGMTH=$ORDER(@DGTEMP@(DGYR,DGQRT,DGMTH))
if 'DGMTH!(EXIT)
QUIT
Begin DoDot:3
+11 ;Check $Y
SET EXIT=$$CHKPGHDR(1)
if EXIT
QUIT
+12 SET DGMTHC=$PIECE("January/February/March/April/May/June/July/August/September/October/November/December/","/",DGMTH)
+13 IF DGSELQ=5
IF "/1/4/7/10/"[("/"_DGMTH_"/")
DO PRINT2
if EXIT
QUIT
+14 SET DGM=$GET(@DGTEMP@(DGYR,DGQRT,DGMTH,"M"))
SET DGF=$GET(@DGTEMP@(DGYR,DGQRT,DGMTH,"F"))
+15 IF DGM
SET DGTM=DGTM+DGM
SET DGYRTM=DGYRTM+DGM
SET DGQRTTM=DGQRTTM+DGM
SET DGTOT=DGTOT+DGM
+16 IF DGF
SET DGTF=DGTF+DGF
SET DGYRTF=DGYRTF+DGF
SET DGQRTTF=DGQRTTF+DGF
SET DGTOT=DGTOT+DGF
+17 WRITE !,DGMTHC,?10,$JUSTIFY($FNUMBER(DGM,","),10),?22,$JUSTIFY($FNUMBER(DGF,","),10)
+18 WRITE ?36,$JUSTIFY($FNUMBER(DGM+DGF,","),10)
End DoDot:3
+19 if EXIT
QUIT
+20 ;Check $Y
SET EXIT=$$CHKPGHDR(2)
if EXIT
QUIT
+21 WRITE !,DGDASH,!,"TOTAL",?10,$JUSTIFY($FNUMBER(DGQRTTM,","),10),?22,$JUSTIFY($FNUMBER(DGQRTTF,","),10),?36,$JUSTIFY($FNUMBER(DGQRTTM+DGQRTTF,","),10)
End DoDot:2
+22 if EXIT
QUIT
+23 ;Check $Y
SET EXIT=$$CHKPGHDR(3)
if EXIT
QUIT
+24 ;Now print Fiscal Year Quarterly summary
+25 WRITE !!,"FISCAL YEAR OVERALL SUMMARY:",!?15,$JUSTIFY("MALE",10),?27,$JUSTIFY("FEMALE",10),?41,$JUSTIFY("TOTAL",10)
+26 SET (DGQRT,EXIT)=0
FOR
SET DGQRT=$ORDER(@DGTEMP@(DGYR,DGQRT))
if 'DGQRT!(EXIT)
QUIT
Begin DoDot:2
+27 ;Check $Y
SET EXIT=$$CHKPGHDR(1,5,1)
if EXIT
QUIT
+28 SET DGM=""
SET (DGMF,DGMM)=0
FOR
SET DGM=$ORDER(@DGTEMP@(DGYR,DGQRT,DGM))
if DGM=""
QUIT
Begin DoDot:3
+29 SET DGMF=DGMF+$GET(@DGTEMP@(DGYR,DGQRT,DGM,"F"))
SET DGMM=DGMM+$GET(@DGTEMP@(DGYR,DGQRT,DGM,"M"))
End DoDot:3
+30 WRITE !,DGYR," QUARTER ",DGQRT,?15,$JUSTIFY($FNUMBER(DGMM,","),10),?27,$JUSTIFY($FNUMBER(DGMF,","),10),?41,$JUSTIFY($FNUMBER(DGMM+DGMF,","),10)
End DoDot:2
+31 ;End of Fiscal Year numbers
+32 ;Check $Y
SET EXIT=$$CHKPGHDR(3,5,1)
if EXIT
QUIT
+33 WRITE !,DGDASH2,!!,"TOTAL PATIENTS REGISTERED FOR THE YEAR: ",?41,$JUSTIFY($FNUMBER(DGYRTM+DGYRTF,","),10)
+34 IF ($GET(IOM)<132)&($EXTRACT(IOST,1,2)="C-")&(IO=IO(0))
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET EXIT=1
End DoDot:1
+35 if 'EXIT
WRITE !!,"TOTAL PATIENTS REGISTERED: ",?41,$JUSTIFY($FNUMBER(DGTOT,","),10)
+36 IF $EXTRACT(IOST,1,2)="C-"
IF 'EXIT
READ !!?8,"End of the Report...Press Enter to Continue",X:DTIME
WRITE @IOF
+37 ;
+38 QUIT
+39 ;
PRINT2 ;
+1 ;Check $Y
SET EXIT=$$CHKPGHDR(3)
+2 if EXIT
QUIT
+3 WRITE !!,DGYR," QUARTER ",$$GETQUART(DGMTH),!
+4 QUIT
+5 ;
CHKPGHDR(LINES,OFFSET,INHIB) ;Check if Page Header needs printing
+1 NEW DIRYT,EXIT
+2 SET EXIT=0
SET OFFSET=+$GET(OFFSET)
SET INHIB=+$GET(INHIB)
+3 IF $Y+LINES>IOSL
IF ($EXTRACT(IOST,1,2)="C-")&(IO=IO(0))
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
Begin DoDot:1
+4 IF $DATA(DIRUT)
SET EXIT=1
QUIT
+5 DO HDR(OFFSET,INHIB)
End DoDot:1
if EXIT
QUIT 1
+6 QUIT EXIT
+7 ;
HDR(OFFSET,INHIB) ;
+1 NEW DGM,DGDT1,DGDT2
+2 SET DGM=$GET(@DGTEMP@(DGYR))
+3 SET OFFSET=+$GET(OFFSET)
SET INHIB=+$GET(INHIB)
+4 SET DGX=$PIECE(^DD(2,.5601,0),U,3)
SET DGDASH=""
SET $PIECE(DGDASH,"-",81)=""
+5 SET DGDT1=$ORDER(DGPER(DGYR,""))
SET DGDT2=$ORDER(DGPER(DGYR,""),-1)
SET DGDT2=$ORDER(DGPER(DGYR,DGDT2,""))
+6 SET DGHDRDT="Date Range : "_$$FMTE^XLFDT(DGDT1,"5PZ")_" - "_$$FMTE^XLFDT(DGDT2,"5PZ")
+7 WRITE @IOF
SET DGX="Presumptive Psychosis Fiscal Year Report"
WRITE $JUSTIFY(" ",80-$LENGTH(DGX)\2),DGX
+8 SET DGX="Report Period: "_$SELECT(DGSELQ=5:"Fiscal Year (All Quarters)",1:"Quarter: "_DGSELQ_" "_$$WHICHMTH(DGSELQ,DGSELM))
WRITE !,$JUSTIFY(" ",80-$LENGTH(DGX)\2),DGX
+9 ;Date Range
WRITE !,$JUSTIFY(" ",80-$LENGTH(DGHDRDT)\2),DGHDRDT
+10 SET DGX="Date Report Printed: "
SET Y=DT
XECUTE ^DD("DD")
SET DGX=DGX_Y
WRITE !,$JUSTIFY(" ",80-$LENGTH(DGX)\2),DGX
+11 SET PAGE=PAGE+1
+12 WRITE ?68,"Page: "_PAGE
+13 if 'INHIB
WRITE !,DGDASH,!,"MONTH",?10+OFFSET,$JUSTIFY("MALE",10),?22+OFFSET,$JUSTIFY("FEMALE",10),?36+OFFSET,$JUSTIFY("TOTAL",10),!,DGDASH
+14 SET DGHDR=1
+15 QUIT
+16 ;
WHICHMTH(DGSELQ,DGSELM) ;Heading shows All Months or just the one month
+1 NEW DGX
+2 IF DGSELM=4
QUIT "All Months"
+3 SET DGX=$$GETMTHS(DGSELQ)
+4 QUIT $PIECE($PIECE(DGX,";",DGSELM),":",2)
+5 ;
FY(DATE) ; return a dates Fiscal Year
+1 NEW YR,FY,MTH,QRT
+2 IF $GET(DATE)?7N.E
SET YR=$SELECT($EXTRACT(DATE,4,5)<10:$EXTRACT(DATE,1,3),1:$EXTRACT(DATE,1,3)+1)
SET FY=$EXTRACT(YR,2,3)
+3 SET MTH=$EXTRACT(DATE,4,5)
SET QRT=$SELECT(MTH<4:2,MTH>3&(MTH<7):3,MTH>6&(MTH<10):4,1:1)
+4 QUIT (($EXTRACT(DATE)-1*1000)+FY)_"Q"_QRT
+5 ;
GETFISC(PROMPT) ;Get from and to Fiscal Years
+1 NEW DGDEFDA,DGDEFFY,DGDTFRM,DGDTTO,DGFIRST,DTOUT,OUT,DIRUT,Y
+2 ;INPUT ; PROMPT - Message to display prior to prompting for dates
+3 ;OUTPUT: 1^BEGDT^ENDDT - Data found
+4 ; 0 - User up arrowed or timed out
+5 ;If they want to show first available date for that set of Status, use this sub
FRMYR ;
+1 WRITE !
+2 ;S OUT=0,DGDTDEF=$$GETDEFD^DGPPRP1() I DGDTDEF="" W !!,"There is no record of patch DG*5.3*977 being installed!",!! Q
+3 SET OUT=0
SET DGDTDEF=3190101
+4 SET DGFIRST=$PIECE($$FY(DGDTDEF),"Q")
+5 SET DGDEFFY=$PIECE($$FY(DT),"Q")
+6 KILL DIR
SET DIR(0)="N^"_DGFIRST_":"_DGDEFFY
SET DIR("A")="Enter 'From' Fiscal Year"
SET DIR("B")=DGFIRST
DO ^DIR
+7 if $DATA(DIRUT)
QUIT 0
+8 SET DGDTFRM=+Y
TOYR ;
+1 ;I DGDTFRM=DGDEFFY Q 1_U_DGDTFRM_U_DGDTFRM
+2 KILL DIR
SET DIR(0)="N^"_DGDTFRM_":"_DGDEFFY
SET DIR("A")="Enter 'To' Fiscal Year"
SET DIR("B")=DGDEFFY
DO ^DIR
+3 ;G:$D(DIRUT) FRMYR
if $DATA(DIRUT)
QUIT 0
+4 SET DGDTTO=+Y
SET OUT=1_U_DGDTFRM_U_DGDTTO
+5 QUIT OUT
+6 ;T
+7 ;
INITTEMP(DGFISCFR,DGFISCTO,DGSELQ,DGSELM) ;
+1 NEW DGI,DGMTHFR,DGMTHTO,DGSEX,DGX,DGYR
+2 if DGSELQ=5
SET DGMTHFR=1
SET DGMTHTO=12
+3 if DGSELQ<5
Begin DoDot:1
+4 SET DGX=$$GETMTHSN(DGSELQ)
+5 IF DGSELM=4
SET DGMTHFR=$PIECE($PIECE(DGX,";"),":",2)
SET DGMTHTO=$PIECE($PIECE(DGX,";",3),":",2)
+6 IF DGSELM<4
SET (DGMTHFR,DGMTHTO)=$PIECE($PIECE(DGX,";",DGSELM),":",2)
End DoDot:1
+7 FOR DGYR=DGFISCFR:1:DGFISCTO
FOR DGI=DGMTHFR:1:DGMTHTO
FOR DGSEX="F","M"
SET @DGTEMP@(DGYR,$$GETQUART(DGI),DGI,DGSEX)=0
+8 QUIT
+9 ;
GETMTH(D) ;
+1 QUIT $SELECT(D="January":1,D="February":2,D="March":3,D="April":4,D="May":5,D="June":6,D="July":7,D="August":8,D="September":9,D="October":10,D="November":11,1:"December")
+2 ;
GETQUART(MTH) ;
+1 QUIT $PIECE("2/2/2/3/3/3/4/4/4/1/1/1/","/",MTH)
+2 ;
GETMTHQ(MTH) ;
+1 QUIT $PIECE("2/2/2/3/3/3/4/4/4/1/1/1/","/",MTH)
+2 ;
GETMTHS(DGSELQ) ;
+1 SET DGX="1:October;2:November;3:December/1:January;2:February;3:March/1:April;2:May;3:June/1:July;2:August;3:September"
+2 QUIT $PIECE(DGX,"/",DGSELQ)
+3 ;
GETMTHSN(DGSELQ) ;
+1 SET DGX="1:10;2:11;3:12/1:1;2:2;3:3/1:4;2:5;3:6/1:7;2:8;3:9"
+2 QUIT $PIECE(DGX,"/",DGSELQ)
+3 ;
OUT ; KILL RETURN ARRAY QUIT
+1 DO ^%ZISC
+2 KILL @DGTEMP
+3 QUIT
