- DGPTCO3 ;ALB/MJK/DHH - Census Status Report ; 3/23/2005
- ;;5.3;Registration;**136,383,432,643,1015**;Aug 13, 1993;Build 21
- ;
- 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
- ;
- DGPTCO3 ;ALB/MJK/DHH - Census Status Report ; 3/23/2005
- +1 ;;5.3;Registration;**136,383,432,643,1015**;Aug 13, 1993;Build 21
- +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 ;
