source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTCO3.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1DGPTCO3 ;ALB/MJK/DHH - Census Status Report ; 3/23/2005
2 ;;5.3;Registration;**136,383,432,643**;Aug 13, 1993
3 ;
4EN 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
14ENQ K DGQ,DHIT,DIOEND,DGC,DGCN,DGCDT,DGIOP,DGCHOICE,DIS
15 Q
16 ;
17START ; -- 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")
34END Q
35 ;
36DOQ ;-- 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
43DOQT ;
44 K Y,DIR
45 Q
46 ;
Note: See TracBrowser for help on using the repository browser.