| [613] | 1 | DGPTCO3 ;ALB/MJK/DHH - Census Status Report ; 3/23/2005
|
|---|
| 2 | ;;5.3;Registration;**136,383,432,643**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN D CHKCUR^DGPTCO1 W ! D DATE^DGPTCO1
|
|---|
| 5 | S DIC("A")="Generate PTF Census Status Report for Census date: ",DIC="^DG(45.86,",DIC(0)="AEMQ" S:Y]"" DIC("B")=Y
|
|---|
| 6 | D ^DIC K DIC G ENQ:Y<0
|
|---|
| 7 | S DGCN=+Y,DGCDT=+$P(Y,U,2)_".9" K DGCHOICE
|
|---|
| 8 | D STATUS^DGPTCO2 G ENQ:'$D(DGCHOICE("STATUS"))
|
|---|
| 9 | S %ZIS="NQ" D ^%ZIS K %ZIS G ENQ:POP D DOQ G ENQ:POP S DGIOP=ION_";"_IOM_";"_IOSL
|
|---|
| 10 | I 'DGQ D START G ENQ
|
|---|
| 11 | S ZTRTN="START^DGPTCO3",ZTIO=DGIOP,ZTDESC="Fee Basis Census Status Report"
|
|---|
| 12 | F X="DGCHOICE(","DGCDT","DGCN","DGIOP" S ZTSAVE(X)=""
|
|---|
| 13 | D ^%ZTLOAD D ^%ZISC
|
|---|
| 14 | ENQ K DGQ,DHIT,DIOEND,DGC,DGCN,DGCDT,DGIOP,DGCHOICE,DIS
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | START ; -- produce report
|
|---|
| 18 | ;Lock global to prevent duplicate entries in Census Workfile
|
|---|
| 19 | L +^DG(45.85,"DGPT CENSUS REGEN WORKFILE"):5 I '$T D Q
|
|---|
| 20 | .N DGPTMSG
|
|---|
| 21 | .D BLDMSG^DGPTCR
|
|---|
| 22 | .I $E(IOST,1,2)'="C-" D SNDMSG^DGPTCR,ENQ Q
|
|---|
| 23 | .N DGPTLINE
|
|---|
| 24 | .S DGPTLINE=0
|
|---|
| 25 | .F S DGPTLINE=$O(DGPTMSG(DGPTLINE)) Q:'DGPTLINE W !,?5,DGPTMSG(DGPTLINE,0)
|
|---|
| 26 | .Q
|
|---|
| 27 | I '$D(^DG(45.85,"ACENSUS",DGCN)) D REGEN^DGPTCR
|
|---|
| 28 | S DIC="^DG(45.85,",(BY,FLDS)="[DGPT FEE BASIS]",L=0,FR=DGCN_",,@",TO=DGCN_",,"
|
|---|
| 29 | I DGCHOICE("STATUS")'="All" S (FR,TO)=DGCN_",,"_DGCHOICE("STATUS")
|
|---|
| 30 | S Y=$P(DGCDT,".") X ^DD("DD") S DHD="Census Status Report for "_Y
|
|---|
| 31 | S IOP=DGIOP K DGC
|
|---|
| 32 | D EN1^DIP,ENQ
|
|---|
| 33 | L -^DG(45.85,"DGPT CENSUS REGEN WORKFILE")
|
|---|
| 34 | END Q
|
|---|
| 35 | ;
|
|---|
| 36 | DOQ ;-- check if output device is queued. if not ask
|
|---|
| 37 | S DGQ=0
|
|---|
| 38 | I $D(IO("Q")) S DGQ=1 G DOQT
|
|---|
| 39 | I IO=IO(0) G DOQT
|
|---|
| 40 | S DIR(0)="Y",DIR("A")="DO YOU WANT YOUR OUTPUT QUEUED",DIR("B")="YES"
|
|---|
| 41 | D ^DIR
|
|---|
| 42 | I Y S DGQ=1
|
|---|
| 43 | DOQT ;
|
|---|
| 44 | K Y,DIR
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
