DGPTF09X.m

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 ---DGPTF09X   2370     printed  Apr 23, 2025@19:06:04                                                                                                                                                                                                    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       ;