| 1 | DGPTF09X ;ALB/MTC - TRANSMIT DELETE PTF MASTER RECORD ;22 FEB 91
|
---|
| 2 | ;;5.3;Registration;**58**;Aug 13, 1993
|
---|
| 3 | EN ; -- generic 099 call
|
---|
| 4 | D INIT^DGPTF099 G ENQ:DGOUT
|
---|
| 5 | F DGLOOP=0:0 D EN1,CONT Q:DGOUT
|
---|
| 6 | K DGLOOP
|
---|
| 7 | G ENQ
|
---|
| 8 | EN1 ; -- init already done
|
---|
| 9 | D SETUP G ENQ:DGOUT
|
---|
| 10 | S DIC="^DGP(45.87,",DIC(0)="L" K DO,DD D NOW^%DTC S X=% D FILE^DICN K DIC
|
---|
| 11 | G ENQ:Y<0 S (DGDA,DA)=+Y
|
---|
| 12 | EDIT S DGPAT=$P(^DGP(45.87,DGDA,0),U,9)
|
---|
| 13 | 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
|
---|
| 14 | SEND S DGOUT=0,DIR(0)="Y",DIR("A")="Ok to Send "_DGCTL,DIR("B")="YES"
|
---|
| 15 | D ^DIR I $D(DIRUT)!(Y=0) D ASK^DGPTRPO G EDIT:'DGOUT I DGOUT D DEL^DGPTRPO G ENQ
|
---|
| 16 | 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
|
---|
| 17 | 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
|
---|
| 18 | Q
|
---|
| 19 | HD099 ;-- header for 099 transaction
|
---|
| 20 | W @IOF,$C(13),?10,">>> Facsimile of 099 Transaction <<<"
|
---|
| 21 | W:DGNAME]"" !,"Patient : ",DGNAME
|
---|
| 22 | W !!,?9,"'",$J(DGCTL,4),"' '",$J(DGSSN,10),"' '",$J(DGADM,10),"' '",$J(DGRFAC,6),"'"
|
---|
| 23 | W !?2,"col# :"
|
---|
| 24 | W ?10,"1--4 5--------1 1--------2 2----3",!
|
---|
| 25 | W ?10," 4 5 4 5 0",!
|
---|
| 26 | W !?2,"block:"
|
---|
| 27 | W ?10," SSN Admitting Requesting",!
|
---|
| 28 | W ?10," Date/Time Facility",!
|
---|
| 29 | W ?10," Num/Suffix",!!
|
---|
| 30 | Q
|
---|
| 31 | ;
|
---|
| 32 | CONT ;-- ask the user if they want to do another
|
---|
| 33 | S DGOUT=0
|
---|
| 34 | S DIR(0)="Y",DIR("A")="Would you like to do another 099 transaction",DIR("B")="NO"
|
---|
| 35 | D ^DIR
|
---|
| 36 | I $D(DIRUT)!(Y=0) S DGOUT=1
|
---|
| 37 | CONTQ K DIR
|
---|
| 38 | Q
|
---|
| 39 | ;
|
---|
| 40 | SETUP S DGOUT=0,VATNAME="PTF125" D ^VATRAN I VATERR S DGOUT=1 G SETQ
|
---|
| 41 | S (DGPAT,DGINST,DGADM,DGSSN,DGTADM,DGFAC,DGFNAM,DGNAME)="",DGRFAC=$E($P($$SITE^VASITE,U,3)_" ",1,6),DGCTL="N099"
|
---|
| 42 | SETQ K VATERR,VATNAME
|
---|
| 43 | Q
|
---|
| 44 | ;
|
---|