DGPTCO3.m

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       ;