Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPPRP5

DGPPRP5.m

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