- DGPTF099 ;ALB/MTC,HIOFO/FT - TRANSMIT DELETE PTF MASTER RECORD ;5/20/15 5:19pm
- ;;5.3;Registration;**884**;Aug 13, 1993;Build 31
- ;
- ; VATRAN - #1011
- ; XMD - #10070
- ; VASITE - #10112
- ; ^DPT - #10035
- ; %ZIS - #10086
- ; XLFSTR - #10104
- ;
- EN ;099 Transmission [DG PTF 099 TRANSMISSION]
- 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," ",241)=""
- 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,240)
- S ^UTILITY($J,"T099",1,1,2,0)=$$REPEAT^XLFSTR(" ",144)
- TRAN ;
- K XMY D ROUTER^DGPTFTR S XMSUB="PTF 099",XMTEXT="^UTILITY("_$J_",""T099"",1,1," D ^XMD
- 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,DO
- 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 -^DGP(45.83)
- K DIE,DR,^UTILITY($J),DA,DUOUT,DTOUT,DGOUT,DGA,DGA1,DFN,DGT,DGX,DFN,DGADM,DGD,DGHEAD,DGINFO,DGJ,DGXX,DIC,DIK,SSN,X,Y,%,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTF099 2810 printed Feb 19, 2025@00:18:02 Page 2
- DGPTF099 ;ALB/MTC,HIOFO/FT - TRANSMIT DELETE PTF MASTER RECORD ;5/20/15 5:19pm
- +1 ;;5.3;Registration;**884**;Aug 13, 1993;Build 31
- +2 ;
- +3 ; VATRAN - #1011
- +4 ; XMD - #10070
- +5 ; VASITE - #10112
- +6 ; ^DPT - #10035
- +7 ; %ZIS - #10086
- +8 ; XLFSTR - #10104
- +9 ;
- EN ;099 Transmission [DG PTF 099 TRANSMISSION]
- +1 DO INIT
- if DGOUT
- GOTO QUIT
- WRITE !!
- +2 SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("A")="Do you wish to send a free-form 099"
- +3 DO ^DIR
- KILL DIR
- if $DATA(DTOUT)!($DATA(DUOUT))
- GOTO QUIT
- +4 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," ",241)=""
- +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,240)
- +5 SET ^UTILITY($JOB,"T099",1,1,2,0)=$$REPEAT^XLFSTR(" ",144)
- TRAN ;
- +1 KILL XMY
- DO ROUTER^DGPTFTR
- SET XMSUB="PTF 099"
- SET XMTEXT="^UTILITY("_$JOB_",""T099"",1,1,"
- DO ^XMD
- +2 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,DO
- +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 ;
- +1 LOCK -^DGP(45.83)
- +2 KILL DIE,DR,^UTILITY($JOB),DA,DUOUT,DTOUT,DGOUT,DGA,DGA1,DFN,DGT,DGX,DFN,DGADM,DGD,DGHEAD,DGINFO,DGJ,DGXX,DIC,DIK,SSN,X,Y,%,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,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