source: WorldVistAEHR/trunk/r/SURGERY-SR/SRHLDW1.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1SRHLDW1 ;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
16END D KDIR Q
17HDR ;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
23ASK ;
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
31ENQ ;
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
38KDIR ;kills all DIR variables
39 K DIR,DIRUT,DUOUT,DTOUT,DIROUT
40 Q
Note: See TracBrowser for help on using the repository browser.