DGPTF09X.m

DGPTF09X ;ALB/MTC - TRANSMIT DELETE PTF MASTER RECORD ;22 FEB 91

 ;;5.3;Registration;**58,1015**;Aug 13, 1993;Build 21

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

 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 S $P(X," ",126)="",^UTILITY($J,"T099",1,1,1,0)=$E(DGCTL_$J(DGSSN,10)_$J(DGADM,10)_$J(DGRFAC,6)_X,1,125) 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

 W @IOF,$C(13),?10,">>> Facsimile of 099 Transaction <<<"

 W:DGNAME]"" !,"Patient : ",DGNAME

 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

 ;

DGPTF09X  ;ALB/MTC - TRANSMIT DELETE PTF MASTER RECORD ;22 FEB 91

 +1       ;;5.3;Registration;**58,1015**;Aug 13, 1993;Build 21

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

 +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

               SET $PIECE(X," ",126)=""

               SET ^UTILITY($JOB,"T099",1,1,1,0)=$EXTRACT(DGCTL_$JUSTIFY(DGSSN,10)_$JUSTIFY(DGADM,10)_$JUSTIFY(DGRFAC,6)_X,1,125)

               DO TRAN^DGPTF099

               WRITE !,"***** 099 TRANSACTION SENT *****"

               SET DIE="^DGP(45.87,"

               SET DA=DGDA

               SET DR=".03////"_XMZ

               DO ^DIE

               KILL DA,XMZ,DIE,DR

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

 +1        WRITE @IOF,$CHAR(13),?10,">>> Facsimile of 099 Transaction <<<"

 +2        IF DGNAME]""

               WRITE !,"Patient : ",DGNAME

 +3        WRITE !!,?9,"'",$JUSTIFY(DGCTL,4),"' '",$JUSTIFY(DGSSN,10),"' '",$JUSTIFY(DGADM,10),"' '",$JUSTIFY(DGRFAC,6),"'"

 +4        WRITE !?2,"col# :"

 +5        WRITE ?10,"1--4   5--------1   1--------2   2----3",!

 +6        WRITE ?10,"                4   5        4   5    0",!

 +7        WRITE !?2,"block:"

 +8        WRITE ?10,"       SSN          Admitting    Requesting",!

 +9        WRITE ?10,"                    Date/Time    Facility",!

 +10       WRITE ?10,"                                 Num/Suffix",!!

 +11       QUIT 

 +12      ;

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       ;