SRHLDW ;B'HAM ISC/DLR - Surgery Interface Master File Update Menu for set of Codes ; [ 05/06/98 7:14 AM ]
;;3.0; Surgery ;**41**;24 Jun 93
; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
N C,CNT,OUT,RNG,SR,SRA,SRTBL,SRX,SRXX,SRY,Y
S (CNT,SRX)=0 F S SRX=$O(^SRO(133.2,SRX)) Q:'SRX I $D(^SRO(133.2,SRX,2,0)) D
.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
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
W @IOF
EXIT D KDIR
Q
HDR ;header for the Table Menu
N HDR,SRX
S HDR="Surgery Interface Table Setup Menu" W ?((IOM-$L(HDR))/2),HDR
W !!,"This option allows the users to populate table files on the Automated",!,"Anesthesia Information System."
W !!
S SRX=0 F S SRX=$O(CNT(SRX)) Q:SRX>(CNT\2+(CNT#2))!('SRX) D
.W !,$J(SRX,2),". ",$P(^SRO(133.2,CNT(SRX),0),U)
.I $D(CNT(SRX+(CNT\2+(CNT#2)))) D
..W ?40,$J(SRX+(CNT\2+(CNT#2)),2),". ",$P(^SRO(133.2,CNT(SRX+(CNT\2+(CNT#2))),0),U)
W ! D KDIR S DIR(0)="LO^1:"_CNT D D ^DIR S:$D(DIRUT) OUT=1 I '$D(DIRUT) S SRTBL=Y
.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."
Q
SET ;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)
N FEC,REC,SRENT
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
S SRENT="",SRTBL=^SRO(133.2,CNT(SRTBL),0),FEC="REP",REC="MAD" D MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)
Q
KDIR ;kills all DIR variables
K DIR,DIRUT,DUOUT,DTOUT,DIROUT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRHLDW 1914 printed Apr 09, 2024@21:44:46 Page 2
SRHLDW ;B'HAM ISC/DLR - Surgery Interface Master File Update Menu for set of Codes ; [ 05/06/98 7:14 AM ]
+1 ;;3.0; Surgery ;**41**;24 Jun 93
+2 ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
+3 NEW C,CNT,OUT,RNG,SR,SRA,SRTBL,SRX,SRXX,SRY,Y
+4 SET (CNT,SRX)=0
FOR
SET SRX=$ORDER(^SRO(133.2,SRX))
if 'SRX
QUIT
IF $DATA(^SRO(133.2,SRX,2,0))
Begin DoDot:1
+5 SET SRY=0
FOR
SET SRY=$ORDER(^SRO(133.2,SRX,2,SRY))
if 'SRY
QUIT
SET SR=^SRO(133.2,SRY,0)
IF $PIECE(SR,U,6)="CE"
SET Y=""
SET C=$PIECE(^DD($PIECE(SR,U,2),$PIECE(SR,U,3),0),U,2)
IF C'["P"
DO Y^DIQ
if '$DATA(SRA(SRY))
SET CNT=CNT+1
SET CNT(CNT)=SRY
IF '$DATA(SRA(SRY))
SET SRA(SRY)=1
End DoDot:1
+6 FOR
WRITE @IOF
SET (OUT,SRTBL)=0
DO HDR
if $GET(OUT)=1
QUIT
SET RNG=Y
FOR SRXX=1:1:$LENGTH(RNG,",")-1
SET SRTBL=$PIECE(RNG,",",SRXX)
DO SET
+7 WRITE @IOF
EXIT DO KDIR
+1 QUIT
HDR ;header for the Table Menu
+1 NEW HDR,SRX
+2 SET HDR="Surgery Interface Table Setup Menu"
WRITE ?((IOM-$LENGTH(HDR))/2),HDR
+3 WRITE !!,"This option allows the users to populate table files on the Automated",!,"Anesthesia Information System."
+4 WRITE !!
+5 SET SRX=0
FOR
SET SRX=$ORDER(CNT(SRX))
if SRX>(CNT\2+(CNT#2))!('SRX)
QUIT
Begin DoDot:1
+6 WRITE !,$JUSTIFY(SRX,2),". ",$PIECE(^SRO(133.2,CNT(SRX),0),U)
+7 IF $DATA(CNT(SRX+(CNT\2+(CNT#2))))
Begin DoDot:2
+8 WRITE ?40,$JUSTIFY(SRX+(CNT\2+(CNT#2)),2),". ",$PIECE(^SRO(133.2,CNT(SRX+(CNT\2+(CNT#2))),0),U)
End DoDot:2
End DoDot:1
+9 WRITE !
DO KDIR
SET DIR(0)="LO^1:"_CNT
Begin DoDot:1
+10 SET 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."
End DoDot:1
DO ^DIR
if $DATA(DIRUT)
SET OUT=1
IF '$DATA(DIRUT)
SET SRTBL=Y
+11 QUIT
SET ;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)
+1 NEW FEC,REC,SRENT
+2 SET DIR(0)="YO"
SET DIR("A")="Update the "_$PIECE(^SRO(133.2,CNT(SRTBL),0),U)_" table"
SET DIR("B")="YES"
DO ^DIR
if Y'=1
QUIT
+3 SET SRENT=""
SET SRTBL=^SRO(133.2,CNT(SRTBL),0)
SET FEC="REP"
SET REC="MAD"
DO MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)
+4 QUIT
KDIR ;kills all DIR variables
+1 KILL DIR,DIRUT,DUOUT,DTOUT,DIROUT
+2 QUIT
