- 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 Feb 19, 2025@00:05:43 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