DGPTCO3 ;ALB/MJK/DHH - Census Status Report ; 3/23/2005
;;5.3;Registration;**136,383,432,643**;Aug 13, 1993
;
EN D CHKCUR^DGPTCO1 W ! D DATE^DGPTCO1
S DIC("A")="Generate PTF Census Status Report for Census date: ",DIC="^DG(45.86,",DIC(0)="AEMQ" S:Y]"" DIC("B")=Y
D ^DIC K DIC G ENQ:Y<0
S DGCN=+Y,DGCDT=+$P(Y,U,2)_".9" K DGCHOICE
D STATUS^DGPTCO2 G ENQ:'$D(DGCHOICE("STATUS"))
S %ZIS="NQ" D ^%ZIS K %ZIS G ENQ:POP D DOQ G ENQ:POP S DGIOP=ION_";"_IOM_";"_IOSL
I 'DGQ D START G ENQ
S ZTRTN="START^DGPTCO3",ZTIO=DGIOP,ZTDESC="Fee Basis Census Status Report"
F X="DGCHOICE(","DGCDT","DGCN","DGIOP" S ZTSAVE(X)=""
D ^%ZTLOAD D ^%ZISC
ENQ K DGQ,DHIT,DIOEND,DGC,DGCN,DGCDT,DGIOP,DGCHOICE,DIS
Q
;
START ; -- produce report
;Lock global to prevent duplicate entries in Census Workfile
L +^DG(45.85,"DGPT CENSUS REGEN WORKFILE"):5 I '$T D Q
.N DGPTMSG
.D BLDMSG^DGPTCR
.I $E(IOST,1,2)'="C-" D SNDMSG^DGPTCR,ENQ Q
.N DGPTLINE
.S DGPTLINE=0
.F S DGPTLINE=$O(DGPTMSG(DGPTLINE)) Q:'DGPTLINE W !,?5,DGPTMSG(DGPTLINE,0)
.Q
I '$D(^DG(45.85,"ACENSUS",DGCN)) D REGEN^DGPTCR
S DIC="^DG(45.85,",(BY,FLDS)="[DGPT FEE BASIS]",L=0,FR=DGCN_",,@",TO=DGCN_",,"
I DGCHOICE("STATUS")'="All" S (FR,TO)=DGCN_",,"_DGCHOICE("STATUS")
S Y=$P(DGCDT,".") X ^DD("DD") S DHD="Census Status Report for "_Y
S IOP=DGIOP K DGC
D EN1^DIP,ENQ
L -^DG(45.85,"DGPT CENSUS REGEN WORKFILE")
END Q
;
DOQ ;-- check if output device is queued. if not ask
S DGQ=0
I $D(IO("Q")) S DGQ=1 G DOQT
I IO=IO(0) G DOQT
S DIR(0)="Y",DIR("A")="DO YOU WANT YOUR OUTPUT QUEUED",DIR("B")="YES"
D ^DIR
I Y S DGQ=1
DOQT ;
K Y,DIR
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTCO3 1655 printed Nov 22, 2024@18:01:52 Page 2
DGPTCO3 ;ALB/MJK/DHH - Census Status Report ; 3/23/2005
+1 ;;5.3;Registration;**136,383,432,643**;Aug 13, 1993
+2 ;
EN DO CHKCUR^DGPTCO1
WRITE !
DO DATE^DGPTCO1
+1 SET DIC("A")="Generate PTF Census Status Report for Census date: "
SET DIC="^DG(45.86,"
SET DIC(0)="AEMQ"
if Y]""
SET DIC("B")=Y
+2 DO ^DIC
KILL DIC
if Y<0
GOTO ENQ
+3 SET DGCN=+Y
SET DGCDT=+$PIECE(Y,U,2)_".9"
KILL DGCHOICE
+4 DO STATUS^DGPTCO2
if '$DATA(DGCHOICE("STATUS"))
GOTO ENQ
+5 SET %ZIS="NQ"
DO ^%ZIS
KILL %ZIS
if POP
GOTO ENQ
DO DOQ
if POP
GOTO ENQ
SET DGIOP=ION_";"_IOM_";"_IOSL
+6 IF 'DGQ
DO START
GOTO ENQ
+7 SET ZTRTN="START^DGPTCO3"
SET ZTIO=DGIOP
SET ZTDESC="Fee Basis Census Status Report"
+8 FOR X="DGCHOICE(","DGCDT","DGCN","DGIOP"
SET ZTSAVE(X)=""
+9 DO ^%ZTLOAD
DO ^%ZISC
ENQ KILL DGQ,DHIT,DIOEND,DGC,DGCN,DGCDT,DGIOP,DGCHOICE,DIS
+1 QUIT
+2 ;
START ; -- produce report
+1 ;Lock global to prevent duplicate entries in Census Workfile
+2 LOCK +^DG(45.85,"DGPT CENSUS REGEN WORKFILE"):5
IF '$TEST
Begin DoDot:1
+3 NEW DGPTMSG
+4 DO BLDMSG^DGPTCR
+5 IF $EXTRACT(IOST,1,2)'="C-"
DO SNDMSG^DGPTCR
DO ENQ
QUIT
+6 NEW DGPTLINE
+7 SET DGPTLINE=0
+8 FOR
SET DGPTLINE=$ORDER(DGPTMSG(DGPTLINE))
if 'DGPTLINE
QUIT
WRITE !,?5,DGPTMSG(DGPTLINE,0)
+9 QUIT
End DoDot:1
QUIT
+10 IF '$DATA(^DG(45.85,"ACENSUS",DGCN))
DO REGEN^DGPTCR
+11 SET DIC="^DG(45.85,"
SET (BY,FLDS)="[DGPT FEE BASIS]"
SET L=0
SET FR=DGCN_",,@"
SET TO=DGCN_",,"
+12 IF DGCHOICE("STATUS")'="All"
SET (FR,TO)=DGCN_",,"_DGCHOICE("STATUS")
+13 SET Y=$PIECE(DGCDT,".")
XECUTE ^DD("DD")
SET DHD="Census Status Report for "_Y
+14 SET IOP=DGIOP
KILL DGC
+15 DO EN1^DIP
DO ENQ
+16 LOCK -^DG(45.85,"DGPT CENSUS REGEN WORKFILE")
END QUIT
+1 ;
DOQ ;-- check if output device is queued. if not ask
+1 SET DGQ=0
+2 IF $DATA(IO("Q"))
SET DGQ=1
GOTO DOQT
+3 IF IO=IO(0)
GOTO DOQT
+4 SET DIR(0)="Y"
SET DIR("A")="DO YOU WANT YOUR OUTPUT QUEUED"
SET DIR("B")="YES"
+5 DO ^DIR
+6 IF Y
SET DGQ=1
DOQT ;
+1 KILL Y,DIR
+2 QUIT
+3 ;
