DGPTF099 ;ALB/MTC - TRANSMIT DELETE PTF MASTER RECORD ; 22 FEB 91
;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
EN D INIT G QUIT:DGOUT W !!
S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you wish to send a free-form 099"
D ^DIR K DIR G QUIT:$D(DTOUT)!($D(DUOUT))
I Y W ! D EN1^DGPTF09X G ENQ
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
I DGRTY=2 S DGPTIFN=DGA D CHK^DGPTFDEL G QUIT:'DGPTIFN
S DIC="^DGPT(",X=DGA,DIC(0)="NME" W ! D ^DIC
S VATNAME="PTF125" D ^VATRAN G QUIT:VATERR
OK W !,"REOPEN & TRANSMIT 099" S %=2 D YN^DICN
I '% W !!?15,"Enter <RET> to exit routine",!?10,"Enter 'Y' for YES to REOPEN & TRANSMIT",! G OK
G ASK:%=2,QUIT:%'=1 S (DA,DGD)=+$O(^DGP(45.83,"C",DGA,0))
I $D(^DGP(45.83,DGD,"P",DGA,0)),'$P(^(0),U,2) G NOTRAN
S DIK="^DGP(45.83,DGD,""P"",",DA(1)=DGD,DA=DGA D ^DIK
I '$O(^DGP(45.83,DGD,"P",0)) S DIK="^DGP(45.83,",DA=DGD D ^DIK
D BUL,LOG W !,"****** 099 TRANSACTION SENT ******"
S DGPTIFN=DGA D OPEN^DGPTFDEL
ENQ G EN
;
BUL ;
S DGINFO=^DGPT(DGA,0),SSN=$P(^DPT(+DGINFO,0),U,9),DGADM=$P($P(DGINFO,U,2),".",1),DGXX="",$P(DGXX," ",126)=""
S DGHEAD="N099"_$S($E(SSN,10)="P":"P",1:" ")_$E(SSN,1,9)
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)
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)
TRAN K XMY D ROUTER^DGPTFTR S XMSUB="PTF 099",XMTEXT="^UTILITY("_$J_",""T099"",1,1," D ^XMD L
Q
LOG ;-- ptf transaction request log
S DIC="^DGP(45.87,",DIC(0)="L" K DO,DD D NOW^%DTC S X=% D FILE^DICN K DIC
G LOGQ:Y<0 S DA=+Y
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)
D ^DIE
K DIE,DR
LOGQ Q
;
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
NOT W !,"RECORD HAS NOT BEEN CLOSED YET!",! K DIC G ASK
NOTRAN W !,"RECORD HAS NOT BEEN TRANSMITTED YET",! K DIC G ASK
;
INIT ;
D LO^DGUTL,HOME^%ZIS S DGOUT=0
L ^DGP(45.83):5 I '$T W !,"Cannot transmit 099 while transmitting other records",! S DGOUT=1 G INITQ
I '$D(DGRTY) S Y=1 D RTY^DGPTUTL
INITQ Q
DGPTF099 ;ALB/MTC - TRANSMIT DELETE PTF MASTER RECORD ; 22 FEB 91
+1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
EN DO INIT
IF DGOUT
GOTO QUIT
WRITE !!
+1 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Do you wish to send a free-form 099"
+2 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO QUIT
+3 IF Y
WRITE !
DO EN1^DGPTF09X
GOTO ENQ
ASK WRITE !!
SET DIC("A")="Enter 099 "_$PIECE(DGRTY0,U)_" record: "
SET DIC="^DGP(45.84,"
SET DIC(0)="AEQMZ"
SET DIC("S")="I $D(^DGP(45.83,""C"",+Y)),$D(^DGPT(+Y,0)),$P(^(0),U,11)="_+DGRTY
DO ^DIC
KILL DIC
IF X=""!(X[U)
GOTO QUIT
IF Y'>0
GOTO NOT
SET DGA=+Y
+1 IF DGRTY=2
SET DGPTIFN=DGA
DO CHK^DGPTFDEL
IF 'DGPTIFN
GOTO QUIT
+2 SET DIC="^DGPT("
SET X=DGA
SET DIC(0)="NME"
WRITE !
DO ^DIC
+3 SET VATNAME="PTF125"
DO ^VATRAN
IF VATERR
GOTO QUIT
OK WRITE !,"REOPEN & TRANSMIT 099"
SET %=2
DO YN^DICN
+1 IF '%
WRITE !!?15,"Enter <RET> to exit routine",!?10,"Enter 'Y' for YES to REOPEN & TRANSMIT",!
GOTO OK
+2 IF %=2
GOTO ASK
IF %'=1
GOTO QUIT
SET (DA,DGD)=+$ORDER(^DGP(45.83,"C",DGA,0))
+3 IF $DATA(^DGP(45.83,DGD,"P",DGA,0))
IF '$PIECE(^(0),U,2)
GOTO NOTRAN
+4 SET DIK="^DGP(45.83,DGD,""P"","
SET DA(1)=DGD
SET DA=DGA
DO ^DIK
+5 IF '$ORDER(^DGP(45.83,DGD,"P",0))
SET DIK="^DGP(45.83,"
SET DA=DGD
DO ^DIK
+6 DO BUL
DO LOG
WRITE !,"****** 099 TRANSACTION SENT ******"
+7 SET DGPTIFN=DGA
DO OPEN^DGPTFDEL
ENQ GOTO EN
+1 ;
BUL ;
+1 SET DGINFO=^DGPT(DGA,0)
SET SSN=$PIECE(^DPT(+DGINFO,0),U,9)
SET DGADM=$PIECE($PIECE(DGINFO,U,2),".",1)
SET DGXX=""
SET $PIECE(DGXX," ",126)=""
+2 SET DGHEAD="N099"_$SELECT($EXTRACT(SSN,10)="P":"P",1:" ")_$EXTRACT(SSN,1,9)
+3 SET DGHEAD=DGHEAD_$EXTRACT(DGADM,4,5)_$EXTRACT(DGADM,6,7)_$EXTRACT(DGADM,2,3)_$EXTRACT($PIECE($PIECE(DGINFO,U,2),".",2)_"0000",1,4)
+4 SET DGHEAD=DGHEAD_$JUSTIFY($PIECE(DGINFO,U,3),3)_$EXTRACT($PIECE(DGINFO,U,5)_" ",1,3)
SET ^UTILITY($JOB,"T099",1,1,1,0)=$EXTRACT(DGHEAD_DGXX,1,125)
TRAN KILL XMY
DO ROUTER^DGPTFTR
SET XMSUB="PTF 099"
SET XMTEXT="^UTILITY("_$JOB_",""T099"",1,1,"
DO ^XMD
LOCK
+1 QUIT
LOG ;-- ptf transaction request log
+1 SET DIC="^DGP(45.87,"
SET DIC(0)="L"
KILL DO,DD
DO NOW^%DTC
SET X=%
DO FILE^DICN
KILL DIC
+2 IF Y<0
GOTO LOGQ
SET DA=+Y
+3 SET DIE="^DGP(45.87,"
SET DR=".02////"_DUZ_";.04////N099;.05////"_SSN_";.06////"_$PIECE(DGINFO,"^",2)_";.03////"_XMZ_";.08////"_$EXTRACT($PIECE($$SITE^VASITE,U,3)_" ",1,6)_";.07////"_$JUSTIFY($PIECE(DGINFO,U,3),3)_$EXTRACT($PIECE(DGINFO,U,5)_" ",1,3)
+4 DO ^DIE
+5 KILL DIE,DR
LOGQ QUIT
+1 ;
QUIT LOCK
KILL DIE,DR,^UTILITY($JOB),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
QUIT
NOT WRITE !,"RECORD HAS NOT BEEN CLOSED YET!",!
KILL DIC
GOTO ASK
NOTRAN WRITE !,"RECORD HAS NOT BEEN TRANSMITTED YET",!
KILL DIC
GOTO ASK
+1 ;
INIT ;
+1 DO LO^DGUTL
DO HOME^%ZIS
SET DGOUT=0
+2 LOCK ^DGP(45.83):5
IF '$TEST
WRITE !,"Cannot transmit 099 while transmitting other records",!
SET DGOUT=1
GOTO INITQ
+3 IF '$DATA(DGRTY)
SET Y=1
DO RTY^DGPTUTL
INITQ QUIT
