| 1 | DGPTF099 ;ALB/MTC - TRANSMIT DELETE PTF MASTER RECORD ; 22 FEB 91
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | EN D INIT G QUIT:DGOUT W !!
|
|---|
| 4 | S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you wish to send a free-form 099"
|
|---|
| 5 | D ^DIR K DIR G QUIT:$D(DTOUT)!($D(DUOUT))
|
|---|
| 6 | I Y W ! D EN1^DGPTF09X G ENQ
|
|---|
| 7 | ASK W !! S DIC("A")="Enter 099 "_$P(DGRTY0,U)_" record: ",DIC="^DGP(45.84,",DIC(0)="AEQMZ",DIC("S")="I $D(^DGP(45.83,""C"",+Y)),$D(^DGPT(+Y,0)),$P(^(0),U,11)="_+DGRTY D ^DIC K DIC G QUIT:X=""!(X[U),NOT:Y'>0 S DGA=+Y
|
|---|
| 8 | I DGRTY=2 S DGPTIFN=DGA D CHK^DGPTFDEL G QUIT:'DGPTIFN
|
|---|
| 9 | S DIC="^DGPT(",X=DGA,DIC(0)="NME" W ! D ^DIC
|
|---|
| 10 | S VATNAME="PTF125" D ^VATRAN G QUIT:VATERR
|
|---|
| 11 | OK W !,"REOPEN & TRANSMIT 099" S %=2 D YN^DICN
|
|---|
| 12 | I '% W !!?15,"Enter <RET> to exit routine",!?10,"Enter 'Y' for YES to REOPEN & TRANSMIT",! G OK
|
|---|
| 13 | G ASK:%=2,QUIT:%'=1 S (DA,DGD)=+$O(^DGP(45.83,"C",DGA,0))
|
|---|
| 14 | I $D(^DGP(45.83,DGD,"P",DGA,0)),'$P(^(0),U,2) G NOTRAN
|
|---|
| 15 | S DIK="^DGP(45.83,DGD,""P"",",DA(1)=DGD,DA=DGA D ^DIK
|
|---|
| 16 | I '$O(^DGP(45.83,DGD,"P",0)) S DIK="^DGP(45.83,",DA=DGD D ^DIK
|
|---|
| 17 | D BUL,LOG W !,"****** 099 TRANSACTION SENT ******"
|
|---|
| 18 | S DGPTIFN=DGA D OPEN^DGPTFDEL
|
|---|
| 19 | ENQ G EN
|
|---|
| 20 | ;
|
|---|
| 21 | BUL ;
|
|---|
| 22 | S DGINFO=^DGPT(DGA,0),SSN=$P(^DPT(+DGINFO,0),U,9),DGADM=$P($P(DGINFO,U,2),".",1),DGXX="",$P(DGXX," ",126)=""
|
|---|
| 23 | S DGHEAD="N099"_$S($E(SSN,10)="P":"P",1:" ")_$E(SSN,1,9)
|
|---|
| 24 | S DGHEAD=DGHEAD_$E(DGADM,4,5)_$E(DGADM,6,7)_$E(DGADM,2,3)_$E($P($P(DGINFO,U,2),".",2)_"0000",1,4)
|
|---|
| 25 | S DGHEAD=DGHEAD_$J($P(DGINFO,U,3),3)_$E($P(DGINFO,U,5)_" ",1,3),^UTILITY($J,"T099",1,1,1,0)=$E(DGHEAD_DGXX,1,125)
|
|---|
| 26 | TRAN K XMY D ROUTER^DGPTFTR S XMSUB="PTF 099",XMTEXT="^UTILITY("_$J_",""T099"",1,1," D ^XMD L
|
|---|
| 27 | Q
|
|---|
| 28 | LOG ;-- ptf transaction request log
|
|---|
| 29 | S DIC="^DGP(45.87,",DIC(0)="L" K DO,DD D NOW^%DTC S X=% D FILE^DICN K DIC
|
|---|
| 30 | G LOGQ:Y<0 S DA=+Y
|
|---|
| 31 | S DIE="^DGP(45.87,",DR=".02////"_DUZ_";.04////N099;.05////"_SSN_";.06////"_$P(DGINFO,"^",2)_";.03////"_XMZ_";.08////"_$E($P($$SITE^VASITE,U,3)_" ",1,6)_";.07////"_$J($P(DGINFO,U,3),3)_$E($P(DGINFO,U,5)_" ",1,3)
|
|---|
| 32 | D ^DIE
|
|---|
| 33 | K DIE,DR
|
|---|
| 34 | LOGQ Q
|
|---|
| 35 | ;
|
|---|
| 36 | QUIT L K DIE,DR,^UTILITY($J),DA,DUOUT,DTOUT,U,DGOUT,DGA,DGA1,DFN,DGT,DGX,DFN,DGADM,DGD,DGHEAD,DGINFO,DGJ,DGXX,DIC,DIK,SSN,X,Y,%,XMDUZ,XMSUB,XMTEXT,XMY,DGRTY,DGRTY0,DGPTIFN,DGPTFMT,VATNAME,VATERR,VAT,DGSDI Q
|
|---|
| 37 | NOT W !,"RECORD HAS NOT BEEN CLOSED YET!",! K DIC G ASK
|
|---|
| 38 | NOTRAN W !,"RECORD HAS NOT BEEN TRANSMITTED YET",! K DIC G ASK
|
|---|
| 39 | ;
|
|---|
| 40 | INIT ;
|
|---|
| 41 | D LO^DGUTL,HOME^%ZIS S DGOUT=0
|
|---|
| 42 | L ^DGP(45.83):5 I '$T W !,"Cannot transmit 099 while transmitting other records",! S DGOUT=1 G INITQ
|
|---|
| 43 | I '$D(DGRTY) S Y=1 D RTY^DGPTUTL
|
|---|
| 44 | INITQ Q
|
|---|
