DGPTF09X ;ALB/MTC,HIOFO/FT - TRANSMIT DELETE PTF MASTER RECORD ;5/26/15 4:27pm
;;5.3;Registration;**58,884**;Aug 13, 1993;Build 31
;
; VATRAN - #1011
; VASITE - #10112
; XLFSTR - #10104
;
EN ; -- generic 099 call
D INIT^DGPTF099 G ENQ:DGOUT
F DGLOOP=0:0 D EN1,CONT Q:DGOUT
K DGLOOP
G ENQ
EN1 ; -- init already done
D SETUP G ENQ:DGOUT
S DIC="^DGP(45.87,",DIC(0)="L" K DO,DD D NOW^%DTC S X=% D FILE^DICN K DIC,DO
G ENQ:Y<0 S (DGDA,DA)=+Y
EDIT S DGPAT=$P(^DGP(45.87,DGDA,0),U,9)
F DGI=0:0 S DA=DGDA,DIE="^DGP(45.87,",DR="[DGPT 099]" D ^DIE,CHKFLD^DGPTRPO Q:'DGOUT D ASK^DGPTRPO I DGOUT D DEL^DGPTRPO G ENQ
SEND S DGOUT=0,DIR(0)="Y",DIR("A")="Ok to Send "_DGCTL,DIR("B")="YES"
D ^DIR I $D(DIRUT)!(Y=0) D ASK^DGPTRPO G EDIT:'DGOUT I DGOUT D DEL^DGPTRPO G ENQ
I Y K X D
.S $P(X," ",241)=""
.S:$E(DGSSN,10)="P" DGSSN="P"_$E(DGSSN,1,9)
.S ^UTILITY($J,"T099",1,1,1,0)=$E(DGCTL_$J(DGSSN,10)_$J(DGADM,10)_$J(DGRFAC,6)_X,1,240)
.S ^UTILITY($J,"T099",1,1,2,0)=$$REPEAT^XLFSTR(" ",144)
.D TRAN^DGPTF099
.W !,"***** 099 TRANSACTION SENT *****"
.S DIE="^DGP(45.87,",DA=DGDA,DR=".03////"_XMZ D ^DIE
.K DA,XMZ,DIE,DR
ENQ K %,DGRTY,DGRFAC,DGTADM,DGPAT,DGINST,DGFNAM,DGNAME,DGCTL,DGADM,DA,DGDA,DGRPO,DIR,DIE,DIK,X,Y,DGOUT,DIRUT,XMTEXT,XMSUB,XMDUZ,DGSSN,DGFAC,DIC,DR,DD,DO,DGI,DQ,DB,DE
Q
HD099 ;-- header for 099 transaction. called from [DGPT 099] input template
W @IOF,$C(13),?10,">>> Facsimile of 099 Transaction <<<"
W:DGNAME]"" !,"Patient : ",DGNAME
S:$E(DGSSN,10)="P" DGSSN="P"_$E(DGSSN,1,9)
W !!,?9,"'",$J(DGCTL,4),"' '",$J(DGSSN,10),"' '",$J(DGADM,10),"' '",$J(DGRFAC,6),"'"
W !?2,"col# :"
W ?10,"1--4 5--------1 1--------2 2----3",!
W ?10," 4 5 4 5 0",!
W !?2,"block:"
W ?10," SSN Admitting Requesting",!
W ?10," Date/Time Facility",!
W ?10," Num/Suffix",!!
Q
;
CONT ;-- ask the user if they want to do another
S DGOUT=0
S DIR(0)="Y",DIR("A")="Would you like to do another 099 transaction",DIR("B")="NO"
D ^DIR
I $D(DIRUT)!(Y=0) S DGOUT=1
CONTQ K DIR
Q
;
SETUP S DGOUT=0,VATNAME="PTF125" D ^VATRAN I VATERR S DGOUT=1 G SETQ
S (DGPAT,DGINST,DGADM,DGSSN,DGTADM,DGFAC,DGFNAM,DGNAME)="",DGRFAC=$E($P($$SITE^VASITE,U,3)_" ",1,6),DGCTL="N099"
SETQ K VATERR,VATNAME
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTF09X 2370 printed Sep 23, 2025@20:27:54 Page 2
DGPTF09X ;ALB/MTC,HIOFO/FT - TRANSMIT DELETE PTF MASTER RECORD ;5/26/15 4:27pm
+1 ;;5.3;Registration;**58,884**;Aug 13, 1993;Build 31
+2 ;
+3 ; VATRAN - #1011
+4 ; VASITE - #10112
+5 ; XLFSTR - #10104
+6 ;
EN ; -- generic 099 call
+1 DO INIT^DGPTF099
if DGOUT
GOTO ENQ
+2 FOR DGLOOP=0:0
DO EN1
DO CONT
if DGOUT
QUIT
+3 KILL DGLOOP
+4 GOTO ENQ
EN1 ; -- init already done
+1 DO SETUP
if DGOUT
GOTO ENQ
+2 SET DIC="^DGP(45.87,"
SET DIC(0)="L"
KILL DO,DD
DO NOW^%DTC
SET X=%
DO FILE^DICN
KILL DIC,DO
+3 if Y<0
GOTO ENQ
SET (DGDA,DA)=+Y
EDIT SET DGPAT=$PIECE(^DGP(45.87,DGDA,0),U,9)
+1 FOR DGI=0:0
SET DA=DGDA
SET DIE="^DGP(45.87,"
SET DR="[DGPT 099]"
DO ^DIE
DO CHKFLD^DGPTRPO
if 'DGOUT
QUIT
DO ASK^DGPTRPO
IF DGOUT
DO DEL^DGPTRPO
GOTO ENQ
SEND SET DGOUT=0
SET DIR(0)="Y"
SET DIR("A")="Ok to Send "_DGCTL
SET DIR("B")="YES"
+1 DO ^DIR
IF $DATA(DIRUT)!(Y=0)
DO ASK^DGPTRPO
if 'DGOUT
GOTO EDIT
IF DGOUT
DO DEL^DGPTRPO
GOTO ENQ
+2 IF Y
KILL X
Begin DoDot:1
+3 SET $PIECE(X," ",241)=""
+4 if $EXTRACT(DGSSN,10)="P"
SET DGSSN="P"_$EXTRACT(DGSSN,1,9)
+5 SET ^UTILITY($JOB,"T099",1,1,1,0)=$EXTRACT(DGCTL_$JUSTIFY(DGSSN,10)_$JUSTIFY(DGADM,10)_$JUSTIFY(DGRFAC,6)_X,1,240)
+6 SET ^UTILITY($JOB,"T099",1,1,2,0)=$$REPEAT^XLFSTR(" ",144)
+7 DO TRAN^DGPTF099
+8 WRITE !,"***** 099 TRANSACTION SENT *****"
+9 SET DIE="^DGP(45.87,"
SET DA=DGDA
SET DR=".03////"_XMZ
DO ^DIE
+10 KILL DA,XMZ,DIE,DR
End DoDot:1
ENQ KILL %,DGRTY,DGRFAC,DGTADM,DGPAT,DGINST,DGFNAM,DGNAME,DGCTL,DGADM,DA,DGDA,DGRPO,DIR,DIE,DIK,X,Y,DGOUT,DIRUT,XMTEXT,XMSUB,XMDUZ,DGSSN,DGFAC,DIC,DR,DD,DO,DGI,DQ,DB,DE
+1 QUIT
HD099 ;-- header for 099 transaction. called from [DGPT 099] input template
+1 WRITE @IOF,$CHAR(13),?10,">>> Facsimile of 099 Transaction <<<"
+2 if DGNAME]""
WRITE !,"Patient : ",DGNAME
+3 if $EXTRACT(DGSSN,10)="P"
SET DGSSN="P"_$EXTRACT(DGSSN,1,9)
+4 WRITE !!,?9,"'",$JUSTIFY(DGCTL,4),"' '",$JUSTIFY(DGSSN,10),"' '",$JUSTIFY(DGADM,10),"' '",$JUSTIFY(DGRFAC,6),"'"
+5 WRITE !?2,"col# :"
+6 WRITE ?10,"1--4 5--------1 1--------2 2----3",!
+7 WRITE ?10," 4 5 4 5 0",!
+8 WRITE !?2,"block:"
+9 WRITE ?10," SSN Admitting Requesting",!
+10 WRITE ?10," Date/Time Facility",!
+11 WRITE ?10," Num/Suffix",!!
+12 QUIT
+13 ;
CONT ;-- ask the user if they want to do another
+1 SET DGOUT=0
+2 SET DIR(0)="Y"
SET DIR("A")="Would you like to do another 099 transaction"
SET DIR("B")="NO"
+3 DO ^DIR
+4 IF $DATA(DIRUT)!(Y=0)
SET DGOUT=1
CONTQ KILL DIR
+1 QUIT
+2 ;
SETUP SET DGOUT=0
SET VATNAME="PTF125"
DO ^VATRAN
IF VATERR
SET DGOUT=1
GOTO SETQ
+1 SET (DGPAT,DGINST,DGADM,DGSSN,DGTADM,DGFAC,DGFNAM,DGNAME)=""
SET DGRFAC=$EXTRACT($PIECE($$SITE^VASITE,U,3)_" ",1,6)
SET DGCTL="N099"
SETQ KILL VATERR,VATNAME
+1 QUIT
+2 ;
