source: WorldVistAEHR/trunk/r/SURGERY-SR/SRHLDW.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1SRHLDW ;B'HAM ISC/DLR - Surgery Interface Master File Update Menu for set of Codes ; [ 05/06/98 7:14 AM ]
2 ;;3.0; Surgery ;**41**;24 Jun 93
3 ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
4 N C,CNT,OUT,RNG,SR,SRA,SRTBL,SRX,SRXX,SRY,Y
5 S (CNT,SRX)=0 F S SRX=$O(^SRO(133.2,SRX)) Q:'SRX I $D(^SRO(133.2,SRX,2,0)) D
6 .S SRY=0 F S SRY=$O(^SRO(133.2,SRX,2,SRY)) Q:'SRY S SR=^SRO(133.2,SRY,0) I $P(SR,U,6)="CE" S Y="",C=$P(^DD($P(SR,U,2),$P(SR,U,3),0),U,2) I C'["P" D Y^DIQ S:'$D(SRA(SRY)) CNT=CNT+1,CNT(CNT)=SRY I '$D(SRA(SRY)) S SRA(SRY)=1
7 F W @IOF S (OUT,SRTBL)=0 D HDR Q:$G(OUT)=1 S RNG=Y F SRXX=1:1:$L(RNG,",")-1 S SRTBL=$P(RNG,",",SRXX) D SET
8 W @IOF
9EXIT D KDIR
10 Q
11HDR ;header for the Table Menu
12 N HDR,SRX
13 S HDR="Surgery Interface Table Setup Menu" W ?((IOM-$L(HDR))/2),HDR
14 W !!,"This option allows the users to populate table files on the Automated",!,"Anesthesia Information System."
15 W !!
16 S SRX=0 F S SRX=$O(CNT(SRX)) Q:SRX>(CNT\2+(CNT#2))!('SRX) D
17 .W !,$J(SRX,2),". ",$P(^SRO(133.2,CNT(SRX),0),U)
18 .I $D(CNT(SRX+(CNT\2+(CNT#2)))) D
19 ..W ?40,$J(SRX+(CNT\2+(CNT#2)),2),". ",$P(^SRO(133.2,CNT(SRX+(CNT\2+(CNT#2))),0),U)
20 W ! D KDIR S DIR(0)="LO^1:"_CNT D D ^DIR S:$D(DIRUT) OUT=1 I '$D(DIRUT) S SRTBL=Y
21 .S DIR("?")="This option sends a message to the Automated Anesthesia Information System (AAIS) informing the system to replace its current field setting with the current VISTA field setting."
22 Q
23SET ;SRTBL - HL7 table FEC - file-level event code (MFE-3) REC - Record-level event code (MFI-1) SRENT - surgery file entry (not used for set of codes)
24 N FEC,REC,SRENT
25 S DIR(0)="YO",DIR("A")="Update the "_$P(^SRO(133.2,CNT(SRTBL),0),U)_" table",DIR("B")="YES" D ^DIR Q:Y'=1
26 S SRENT="",SRTBL=^SRO(133.2,CNT(SRTBL),0),FEC="REP",REC="MAD" D MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)
27 Q
28KDIR ;kills all DIR variables
29 K DIR,DIRUT,DUOUT,DTOUT,DIROUT
30 Q
Note: See TracBrowser for help on using the repository browser.