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

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

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1DGPTC ;ALB/MJK - Census Main Options; 15 APR 90 ; 5/11/01 1:15pm
2 ;;5.3;Registration;**383,643,702**;Aug 13, 1993
3 ;
4 D DT^DICRW S X="DGPTC",DIK="^DOPT("""_X_""","
5 G A:$D(^DOPT(X,10))
6 S ^DOPT(X,0)="Census Main Options^1N^"
7 F I=1:1 S Y=$T(@I) Q:Y="" S ^DOPT(X,I,0)=$P(Y,";",3,99)
8 D IXALL^DIK
9 ;
10A W !! S DIC="^DOPT(""DGPTC"",",DIC(0)="IQEAM"
11 D ^DIC Q:Y<0 D @+Y G A
12 ;
131 ;;Load/Edit PTF Record
14 G ^DGPTF
15 ;
162 ;;Release Closed Census Record
17 S Y=2 D RTY^DGPTUTL,^DGPTFREL
18 Q
19 ;
203 ;;Open Closed Census Record
21 S Y=2 D RTY^DGPTUTL,HEL^DGPTFDEL
22 K DGADM,DGDOM,DGNHCU,MASD,MASDEV,PARA,DG,DGHEM Q
23 ;
244 ;;Transmit Census Records
25 D CLOSE G Q4:'Y
26 S Y=2 D RTY^DGPTUTL,^DGPTFTR
27Q4 K DGCN,DGCN0 Q
28 ;
295 ;;Re-Open Released/Transmitted Records
30 S Y=2 D RTY^DGPTUTL,DREL^DGPTFDEL
31 Q
32 ;
336 ;;Census Outputs
34 G ^DGPTCO
35 ;
367 ;;Census Date Parameters
37 D CHKCUR^DGPTCO1
38 K DGDASH W ! D DATE^DGPTCO1 S:Y]"" DIC("B")=Y
39 S DIC="^DG(45.86,",DIC(0)="AELMQ" D ^DIC K DIC G Q7:Y<0
40 S (D0,DGCN)=+Y D PAR
41 ;S DA=DGCN,DIE="^DG(45.86,",DR="[DGPT CENSUS DATE]" D ^DIE K DIE,DR,DQ,DE
42 ;I '$D(Y) S D0=DGCN D PAR W !!
43Q7 K DGCN,D0,DA Q
44 ;
458 ;;Regenerate Census WorkFile
46 D GEN^DGPTCR
47 Q
48 ;
499 ;;Send 099 Transmission for Census Record
50 D CLOSE G Q9:'Y
51 S Y=2 D RTY^DGPTUTL,EN^DGPTF099
52Q9 K DGCN,DGCN0 Q
53 ;
5410 ;;Close Census Reord
55 W ! S DIC="^DGPT(",DIC(0)="AEMZQ",DIC("S")="I '$P(^(0),U,6),$P(^(0),U,11)=1"
56 D ^DIC K DIC G Q10:Y<0
57 S (DGPTF,PTF)=+Y,DFN=+Y(0) D PM^DGPTUTL,CEN^DGPTC1
58 I '$D(DGCST) W !!,*7," >>>> Census transactions are not required for this PTF record." G 10
59 I DGCST W !!,*7," >>>> This PTF record is already closed for census. (Census #",$S($D(DGCI):DGCI,1:""),")" G 10
60 D UPDT^DGPTUTL:'$P(Y(0),U,4) S DGPTFE=$P(^DGPT(PTF,0),U,4)
61 S Y=+$S($D(^DG(45.86,+DGCN,0)):+^(0),1:"") D FMT^DGPTUTL
62 S Y=2 D RTY^DGPTUTL
63 D CLS^DGPTC1
64 I 'DGCST W !!," >>>> Not able to close for census. Please use 'Load/Edit' option to edit PTF."
65 D Q1^DGPTF G 10
66Q10 K DG1,DGL,DGADM,DGPTFMT,DFN,PTF,DGPTFE,DGRTY,DGRTY0,DGPTF D KVAR^DGPTC1 Q
67 ;
68CLOSE ; -- can we xmit?
69 D CEN^DGPTUTL S Y=1
70 I 'DGCN W !!?5,*7,"There is currently no active census being conducted." S Y=0 G CLOSEQ
71 I DT>$P(DGCN0,U,2) S Y=$P(DGCN0,U,2) X ^DD("DD") W !!?5,*7,"Census Close date has passed (",Y,").",!?5,"No transmissions allowed." S Y=0 G CLOSEQ
72CLOSEQ Q
73 ;
74PAR ; census date parameter profile
75 ; input: D0 := ifn of ^DG(45.86)
76 S X="DGPTXCP" X ^%ZOSF("TEST") G PARQ:'$T
77 K DGDASH,DXS S $P(DGDASH,"-",81)="",IOP="HOME" D ^%ZIS K IOP
78 W @IOF,*13,$E(DGDASH,1,28)," Quick Parameter Profile ",$E(DGDASH,1,27)
79 D ^DGPTXCP W !,DGDASH
80PARQ K DGDASH,DXS Q
Note: See TracBrowser for help on using the repository browser.