[613] | 1 | DGPTC ;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 | ;
|
---|
| 10 | A W !! S DIC="^DOPT(""DGPTC"",",DIC(0)="IQEAM"
|
---|
| 11 | D ^DIC Q:Y<0 D @+Y G A
|
---|
| 12 | ;
|
---|
| 13 | 1 ;;Load/Edit PTF Record
|
---|
| 14 | G ^DGPTF
|
---|
| 15 | ;
|
---|
| 16 | 2 ;;Release Closed Census Record
|
---|
| 17 | S Y=2 D RTY^DGPTUTL,^DGPTFREL
|
---|
| 18 | Q
|
---|
| 19 | ;
|
---|
| 20 | 3 ;;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 | ;
|
---|
| 24 | 4 ;;Transmit Census Records
|
---|
| 25 | D CLOSE G Q4:'Y
|
---|
| 26 | S Y=2 D RTY^DGPTUTL,^DGPTFTR
|
---|
| 27 | Q4 K DGCN,DGCN0 Q
|
---|
| 28 | ;
|
---|
| 29 | 5 ;;Re-Open Released/Transmitted Records
|
---|
| 30 | S Y=2 D RTY^DGPTUTL,DREL^DGPTFDEL
|
---|
| 31 | Q
|
---|
| 32 | ;
|
---|
| 33 | 6 ;;Census Outputs
|
---|
| 34 | G ^DGPTCO
|
---|
| 35 | ;
|
---|
| 36 | 7 ;;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 !!
|
---|
| 43 | Q7 K DGCN,D0,DA Q
|
---|
| 44 | ;
|
---|
| 45 | 8 ;;Regenerate Census WorkFile
|
---|
| 46 | D GEN^DGPTCR
|
---|
| 47 | Q
|
---|
| 48 | ;
|
---|
| 49 | 9 ;;Send 099 Transmission for Census Record
|
---|
| 50 | D CLOSE G Q9:'Y
|
---|
| 51 | S Y=2 D RTY^DGPTUTL,EN^DGPTF099
|
---|
| 52 | Q9 K DGCN,DGCN0 Q
|
---|
| 53 | ;
|
---|
| 54 | 10 ;;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
|
---|
| 66 | Q10 K DG1,DGL,DGADM,DGPTFMT,DFN,PTF,DGPTFE,DGRTY,DGRTY0,DGPTF D KVAR^DGPTC1 Q
|
---|
| 67 | ;
|
---|
| 68 | CLOSE ; -- 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
|
---|
| 72 | CLOSEQ Q
|
---|
| 73 | ;
|
---|
| 74 | PAR ; 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
|
---|
| 80 | PARQ K DGDASH,DXS Q
|
---|