| 1 | SRHLDW1 ;B'HAM ISC/DLR - Surgery Interface Master File Update Menu for Files ; [ 06/11/98 6:17 AM ]
|
|---|
| 2 | ;;3.0; Surgery ;**41**;24 Jun 93
|
|---|
| 3 | ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
|---|
| 4 | N CNT,OUT,SRTYP
|
|---|
| 5 | ;Interface Files (1st 3 letter must be unique for the TMP global)
|
|---|
| 6 | S CNT(1)="CPT4^81"
|
|---|
| 7 | S CNT(2)="ICD9^80"
|
|---|
| 8 | S CNT(3)="MEDICATION^50"
|
|---|
| 9 | S CNT(4)="MONITOR^133.4"
|
|---|
| 10 | S CNT(5)="PERSONNEL^200"
|
|---|
| 11 | S CNT(6)="REPLACEMENT FLUID^133.7"
|
|---|
| 12 | S CNT(7)="ANES SUPERVISE CODE^132.95"
|
|---|
| 13 | S CNT(8)="LOCATION^44"
|
|---|
| 14 | F W @IOF S (OUT,SRTYP)=0 D HDR Q:$G(OUT)=1 D ASK
|
|---|
| 15 | W @IOF
|
|---|
| 16 | END D KDIR Q
|
|---|
| 17 | HDR ;header for the OBR Menu
|
|---|
| 18 | N HDR,SRX,C
|
|---|
| 19 | S HDR="Surgery Interface File Download Option" W ?((IOM-$L(HDR))/2),HDR,!!
|
|---|
| 20 | S SRX=0 F S SRX=$O(CNT(SRX)) Q:'SRX S C=$G(C)+1 W !,SRX,". ",$P(CNT(SRX),"^")
|
|---|
| 21 | W ! D KDIR S DIR(0)="NO^1:"_C,DIR("A")="Enter file to Capture",DIR("?")="Enter the files corresponding number" D ^DIR S:$D(DIRUT) OUT=1 I '$D(DIRUT) D KDIR S SRTYP=Y
|
|---|
| 22 | Q
|
|---|
| 23 | ASK ;
|
|---|
| 24 | N G
|
|---|
| 25 | S DIR(0)="YO",DIR("B")="YES",DIR("A")="Update the "_$P(CNT(SRTYP),U)_" file",DIR("B")="YES" D ^DIR I $D(DIRUT)!(Y=0) S OUT=1 Q
|
|---|
| 26 | I $P(CNT(SRTYP),U)="CPT4" W !,"NOT AVAILABLE" Q
|
|---|
| 27 | W !,"Queuing message" S ZTDTH=$H,ZTIO="",ZTDESC=$P(CNT(SRTYP),U)_" Master File Update.",ZTRTN="ENQ^SRHLDW1"
|
|---|
| 28 | F G="SRTYP","CNT("_SRTYP_")" S:$D(@G) ZTSAVE(G)=""
|
|---|
| 29 | D ^%ZTLOAD
|
|---|
| 30 | Q
|
|---|
| 31 | ENQ ;
|
|---|
| 32 | N FEC,REC,SRENT,SRTBL
|
|---|
| 33 | S SRENT="",FEC="REP",REC="MAD",SRTBL=CNT(SRTYP)
|
|---|
| 34 | ;cpt4,icd9,medication,monitor,personnel,replacement fluid,anes super code,location
|
|---|
| 35 | D MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)
|
|---|
| 36 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 37 | Q
|
|---|
| 38 | KDIR ;kills all DIR variables
|
|---|
| 39 | K DIR,DIRUT,DUOUT,DTOUT,DIROUT
|
|---|
| 40 | Q
|
|---|
