SRHLSCRN ;B'HAM ISC/DLR - Surgery Interface Menu to initial field settings ; [ 05/06/98 7:14 AM ]
;;3.0;Surgery ;**41,186**;24 Jun 93;Build 3
; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
N CNT,CNT1,OUT,SRA,SRX,SRY,SROBR,SROBX
S (CNT,SRX)=0 F S SRX=$O(^SRO(133.2,SRX)) Q:'SRX I $D(^SRO(133.2,SRX,2,0)) S CNT=CNT+1,CNT(CNT)=SRX D
.S (CNT1,SRY)=0 F S SRY=$O(^SRO(133.2,SRX,2,SRY)) Q:'SRY S CNT1=CNT1+1,CNT(CNT,CNT1)=SRY,CNT(CNT,0)=CNT1
F W @IOF S (OUT,SROBR)=0 S SROBR=$$HDR(SROBR) Q:$G(OUT)=1 D
.I +SROBR>0&(+SROBR'>CNT) D OBR Q:$G(OUT)=1 F W @IOF S SROBX=0 S OUT=0,SROBX=$$HDR1(SROBR,SROBX) Q:$G(OUT)=1 D:$D(CNT(SROBR,SROBX))
..D KDIR S DA=CNT(SROBR,SROBX),DIR("A")="Enter the new setting",DIR(0)="133.2,3" D ^DIR I $D(DIRUT) S OUT=1 Q
..I SRA'[Y,Y'="I" W !,"This setting does not correspond to the upper level setting.",!," Press <RETURN> to continue:" R X:DTIME Q
..S $P(^SRO(133.2,CNT(SROBR,SROBX),0),U,4)=Y I $D(^(1,0)) S X=0 F S X=$O(^SRO(133.2,CNT(SROBR,SROBX),1,X)) Q:'X S $P(^SRO(133.2,X,0),U,4)=Y
W @IOF
EXIT D KDIR
Q
HDR(SROBR) ;header for the OBR Menu
N HDR,SRX
S HDR="Surgery Interface Setup Menu" W ?((IOM-$L(HDR))/2),HDR
W !!,"To change the setting in one of the following categories, enter the",!,"corresponding number.",!," (R - Receive)",!," (S - Send)",!," (S/R - Send and Receive)",!," (I - Ignore)"
W !!
S SRX=0 F S SRX=$O(CNT(SRX)) Q:'SRX W !,$J(SRX,3),". ",$P(^SRO(133.2,CNT(SRX),0),U)," ",$S($P(^(0),U,4)'="":"("_$P(^(0),U,4)_")",1:"(I)")
W ! D KDIR S DIR(0)="NO:1:CNT" D D ^DIR S:$D(DIRUT) OUT=1 I '$D(DIRUT) S SROBR=Y
.S DIR("?")="Enter the corresponding number of the category you wish to edit. To edit underlying fields, set the category to R for receive or S to send."
.S DIR("?",1)="The categories above refer to VISTA Surgery data fields. Below are examples:"
.S DIR("?",2)="OPERATION -> File 130 fields."
.S DIR("?",3)="TOURNIQUET -> TIME TOURNIQUET APPLIED (#.48) and File 130.02 fields."
.S DIR("?",4)="MONITOR -> MONITORS (#.293) and File 130.41 fields."
.S DIR("?",5)="MEDICATION -> MEDICATIONS (#.375) and File 130.33 fields."
.S DIR("?",6)="ANESTHESIA -> ANESTHESIA TECHNIQUE (#.37) and File 130.06 fields."
Q SROBR
HDR1(SROBR,SROBX) ;header for the OBX Menu
N HDR1,SRX
S HDR1=$P(^SRO(133.2,CNT(SROBR),0),U)_" DATA" W ?((IOM-$L(HDR1))/2),HDR1
W !!,"Toggle the current setting to (R)eceive, (S)end, or (I)gnore."
W !
S SRX=0 F S SRX=$O(CNT(SROBR,SRX)) Q:SRX>(CNT(SROBR,0)\2+(CNT(SROBR,0)#2))!('SRX) D
.W !,$J(SRX,2),". ",$P(^SRO(133.2,CNT(SROBR,SRX),0),U)," ",$S($P(^(0),U,4)'="":"("_$P(^(0),U,4)_")",1:"(I)")
.I $D(CNT(SROBR,SRX+(CNT(SROBR,0)\2+(CNT(SROBR,0)#2)))) D
..W ?40,$J(SRX+(CNT(SROBR,0)\2+(CNT(SROBR,0)#2)),2),". ",$P(^SRO(133.2,CNT(SROBR,SRX+(CNT(SROBR,0)\2+(CNT(SROBR,0)#2))),0),U)," ",$S($P(^(0),U,4)'="":"("_$P(^(0),U,4)_")",1:"(I)")
W ! D KDIR S DIR(0)="NO:1:CNT(SROBR,0)",DIR("?")="To toggle the current setting of an item, enter its corresponding number." D SDIR D ^DIR S:$D(DIRUT) OUT=1 I '$D(DIRUT) S SROBX=Y
Q SROBX
OBR ;
N X,X1
D KDIR S DIR("A")="Do you wish to change the current setting of "_$P(^SRO(133.2,CNT(SROBR),0),U),DIR(0)="133.2,3^O",DA=CNT(SROBR) D ^DIR I $D(DIRUT) S OUT=1 Q
S $P(^SRO(133.2,CNT(SROBR),0),U,4)=Y I $D(^SRO(133.2,CNT(SROBR),1,0)) S X=0 F S X=$O(^SRO(133.2,CNT(SROBR),1,X)) Q:'X S:Y'="S/R" $P(^SRO(133.2,X,0),U,4)=Y
S SRA=Y I Y="S/R" K DA
I SRA="S" D
.I $D(^SRO(133.2,CNT(SROBR),1,0)) S X=0 F S X=$O(^SRO(133.2,CNT(SROBR),1,X)) Q:'X S:$P(^SRO(133.2,X,0),U,4)="R" $P(^SRO(133.2,X,0),U,4)="S"
.I $D(^SRO(133.2,CNT(SROBR),2,0)) S X=0 F S X=$O(^SRO(133.2,CNT(SROBR),2,X)) Q:'X S:$P(^SRO(133.2,X,0),U,4)="R" $P(^(0),U,4)="S" I $D(^SRO(133.2,X,1,0)) S X1=0 F S X1=$O(^SRO(133.2,X,1,X1)) Q:'X1 S $P(^SRO(133.2,X1,0),U,4)="S"
I SRA="R" D
.I $D(^SRO(133.2,CNT(SROBR),1,0)) S X=0 F S X=$O(^SRO(133.2,CNT(SROBR),1,X)) Q:'X S:$P(^SRO(133.2,X,0),U,4)="S" $P(^SRO(133.2,X,0),U,4)="R"
.I $D(^SRO(133.2,CNT(SROBR),2,0)) S X=0 F S X=$O(^SRO(133.2,CNT(SROBR),2,X)) Q:'X S:$P(^SRO(133.2,X,0),U,4)="S" $P(^(0),U,4)="R" I $D(^SRO(133.2,X,1,0)) S X1=0 F S X1=$O(^SRO(133.2,X,1,X1)) Q:'X1 S $P(^SRO(133.2,X1,0),U,4)="R"
I $P(^SRO(133.2,CNT(SROBR),0),U,4)="I" S OUT=1
Q
KDIR ;kills all DIR variables
K DIR,DIRUT,DUOUT,DTOUT,DIROUT
Q
SDIR ;sets the DIR help screen for the OBX identifiers
S DIR("?",1)="These items correspond to fields in the VISTA Surgery package."
I SROBR=1 D
.S DIR("?",1)="The items above refer to VISTA Surgery package fields. Below are examples:"
.S DIR("?",2)=" HR -> End Pulse (#.84)"
.S DIR("?",3)=" BP -> End BP (#.85)"
.S DIR("?",4)=" RR -> End Resp (#.86)"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRHLSCRN 4731 printed Nov 22, 2024@17:49:20 Page 2
SRHLSCRN ;B'HAM ISC/DLR - Surgery Interface Menu to initial field settings ; [ 05/06/98 7:14 AM ]
+1 ;;3.0;Surgery ;**41,186**;24 Jun 93;Build 3
+2 ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
+3 NEW CNT,CNT1,OUT,SRA,SRX,SRY,SROBR,SROBX
+4 SET (CNT,SRX)=0
FOR
SET SRX=$ORDER(^SRO(133.2,SRX))
if 'SRX
QUIT
IF $DATA(^SRO(133.2,SRX,2,0))
SET CNT=CNT+1
SET CNT(CNT)=SRX
Begin DoDot:1
+5 SET (CNT1,SRY)=0
FOR
SET SRY=$ORDER(^SRO(133.2,SRX,2,SRY))
if 'SRY
QUIT
SET CNT1=CNT1+1
SET CNT(CNT,CNT1)=SRY
SET CNT(CNT,0)=CNT1
End DoDot:1
+6 FOR
WRITE @IOF
SET (OUT,SROBR)=0
SET SROBR=$$HDR(SROBR)
if $GET(OUT)=1
QUIT
Begin DoDot:1
+7 IF +SROBR>0&(+SROBR'>CNT)
DO OBR
if $GET(OUT)=1
QUIT
FOR
WRITE @IOF
SET SROBX=0
SET OUT=0
SET SROBX=$$HDR1(SROBR,SROBX)
if $GET(OUT)=1
QUIT
if $DATA(CNT(SROBR,SROBX))
Begin DoDot:2
+8 DO KDIR
SET DA=CNT(SROBR,SROBX)
SET DIR("A")="Enter the new setting"
SET DIR(0)="133.2,3"
DO ^DIR
IF $DATA(DIRUT)
SET OUT=1
QUIT
+9 IF SRA'[Y
IF Y'="I"
WRITE !,"This setting does not correspond to the upper level setting.",!," Press <RETURN> to continue:"
READ X:DTIME
QUIT
+10 SET $PIECE(^SRO(133.2,CNT(SROBR,SROBX),0),U,4)=Y
IF $DATA(^(1,0))
SET X=0
FOR
SET X=$ORDER(^SRO(133.2,CNT(SROBR,SROBX),1,X))
if 'X
QUIT
SET $PIECE(^SRO(133.2,X,0),U,4)=Y
End DoDot:2
End DoDot:1
+11 WRITE @IOF
EXIT DO KDIR
+1 QUIT
HDR(SROBR) ;header for the OBR Menu
+1 NEW HDR,SRX
+2 SET HDR="Surgery Interface Setup Menu"
WRITE ?((IOM-$LENGTH(HDR))/2),HDR
+3 WRITE !!,"To change the setting in one of the following categories, enter the",!,"corresponding number.",!," (R - Receive)",!," (S - Send)",!," (S/R - Send and Receive)",!," (I - Ignore)"
+4 WRITE !!
+5 SET SRX=0
FOR
SET SRX=$ORDER(CNT(SRX))
if 'SRX
QUIT
WRITE !,$JUSTIFY(SRX,3),". ",$PIECE(^SRO(133.2,CNT(SRX),0),U)," ",$SELECT($PIECE(^(0),U,4)'="":"("_$PIECE(^(0),U,4)_")",1:"(I)")
+6 WRITE !
DO KDIR
SET DIR(0)="NO:1:CNT"
Begin DoDot:1
+7 SET DIR("?")="Enter the corresponding number of the category you wish to edit. To edit underlying fields, set the category to R for receive or S to send."
+8 SET DIR("?",1)="The categories above refer to VISTA Surgery data fields. Below are examples:"
+9 SET DIR("?",2)="OPERATION -> File 130 fields."
+10 SET DIR("?",3)="TOURNIQUET -> TIME TOURNIQUET APPLIED (#.48) and File 130.02 fields."
+11 SET DIR("?",4)="MONITOR -> MONITORS (#.293) and File 130.41 fields."
+12 SET DIR("?",5)="MEDICATION -> MEDICATIONS (#.375) and File 130.33 fields."
+13 SET DIR("?",6)="ANESTHESIA -> ANESTHESIA TECHNIQUE (#.37) and File 130.06 fields."
End DoDot:1
DO ^DIR
if $DATA(DIRUT)
SET OUT=1
IF '$DATA(DIRUT)
SET SROBR=Y
+14 QUIT SROBR
HDR1(SROBR,SROBX) ;header for the OBX Menu
+1 NEW HDR1,SRX
+2 SET HDR1=$PIECE(^SRO(133.2,CNT(SROBR),0),U)_" DATA"
WRITE ?((IOM-$LENGTH(HDR1))/2),HDR1
+3 WRITE !!,"Toggle the current setting to (R)eceive, (S)end, or (I)gnore."
+4 WRITE !
+5 SET SRX=0
FOR
SET SRX=$ORDER(CNT(SROBR,SRX))
if SRX>(CNT(SROBR,0)\2+(CNT(SROBR,0)#2))!('SRX)
QUIT
Begin DoDot:1
+6 WRITE !,$JUSTIFY(SRX,2),". ",$PIECE(^SRO(133.2,CNT(SROBR,SRX),0),U)," ",$SELECT($PIECE(^(0),U,4)'="":"("_$PIECE(^(0),U,4)_")",1:"(I)")
+7 IF $DATA(CNT(SROBR,SRX+(CNT(SROBR,0)\2+(CNT(SROBR,0)#2))))
Begin DoDot:2
+8 WRITE ?40,$JUSTIFY(SRX+(CNT(SROBR,0)\2+(CNT(SROBR,0)#2)),2),". ",$PIECE(^SRO(133.2,CNT(SROBR,SRX+(CNT(SROBR,0)\2+(CNT(SROBR,0)#2))),0),U)," ",$SELECT($PIECE(^(0),U,4)'="":"("_$PIECE(^(0),U,4)_")",1:"(I)")
End DoDot:2
End DoDot:1
+9 WRITE !
DO KDIR
SET DIR(0)="NO:1:CNT(SROBR,0)"
SET DIR("?")="To toggle the current setting of an item, enter its corresponding number."
DO SDIR
DO ^DIR
if $DATA(DIRUT)
SET OUT=1
IF '$DATA(DIRUT)
SET SROBX=Y
+10 QUIT SROBX
OBR ;
+1 NEW X,X1
+2 DO KDIR
SET DIR("A")="Do you wish to change the current setting of "_$PIECE(^SRO(133.2,CNT(SROBR),0),U)
SET DIR(0)="133.2,3^O"
SET DA=CNT(SROBR)
DO ^DIR
IF $DATA(DIRUT)
SET OUT=1
QUIT
+3 SET $PIECE(^SRO(133.2,CNT(SROBR),0),U,4)=Y
IF $DATA(^SRO(133.2,CNT(SROBR),1,0))
SET X=0
FOR
SET X=$ORDER(^SRO(133.2,CNT(SROBR),1,X))
if 'X
QUIT
if Y'="S/R"
SET $PIECE(^SRO(133.2,X,0),U,4)=Y
+4 SET SRA=Y
IF Y="S/R"
KILL DA
+5 IF SRA="S"
Begin DoDot:1
+6 IF $DATA(^SRO(133.2,CNT(SROBR),1,0))
SET X=0
FOR
SET X=$ORDER(^SRO(133.2,CNT(SROBR),1,X))
if 'X
QUIT
if $PIECE(^SRO(133.2,X,0),U,4)="R"
SET $PIECE(^SRO(133.2,X,0),U,4)="S"
+7 IF $DATA(^SRO(133.2,CNT(SROBR),2,0))
SET X=0
FOR
SET X=$ORDER(^SRO(133.2,CNT(SROBR),2,X))
if 'X
QUIT
if $PIECE(^SRO(133.2,X,0),U,4)="R"
SET $PIECE(^(0),U,4)="S"
IF $DATA(^SRO(133.2,X,1,0))
SET X1=0
FOR
SET X1=$ORDER(^SRO(133.2,X,1,X1))
if 'X1
QUIT
SET $PIECE(^SRO(133.2,X1,0),U,4)="S"
End DoDot:1
+8 IF SRA="R"
Begin DoDot:1
+9 IF $DATA(^SRO(133.2,CNT(SROBR),1,0))
SET X=0
FOR
SET X=$ORDER(^SRO(133.2,CNT(SROBR),1,X))
if 'X
QUIT
if $PIECE(^SRO(133.2,X,0),U,4)="S"
SET $PIECE(^SRO(133.2,X,0),U,4)="R"
+10 IF $DATA(^SRO(133.2,CNT(SROBR),2,0))
SET X=0
FOR
SET X=$ORDER(^SRO(133.2,CNT(SROBR),2,X))
if 'X
QUIT
if $PIECE(^SRO(133.2,X,0),U,4)="S"
SET $PIECE(^(0),U,4)="R"
IF $DATA(^SRO(133.2,X,1,0))
SET X1=0
FOR
SET X1=$ORDER(^SRO(133.2,X,1,X1))
if 'X1
QUIT
SET $PIECE(^SRO(133.2,X1,0),U,4)="R"
End DoDot:1
+11 IF $PIECE(^SRO(133.2,CNT(SROBR),0),U,4)="I"
SET OUT=1
+12 QUIT
KDIR ;kills all DIR variables
+1 KILL DIR,DIRUT,DUOUT,DTOUT,DIROUT
+2 QUIT
SDIR ;sets the DIR help screen for the OBX identifiers
+1 SET DIR("?",1)="These items correspond to fields in the VISTA Surgery package."
+2 IF SROBR=1
Begin DoDot:1
+3 SET DIR("?",1)="The items above refer to VISTA Surgery package fields. Below are examples:"
+4 SET DIR("?",2)=" HR -> End Pulse (#.84)"
+5 SET DIR("?",3)=" BP -> End BP (#.85)"
+6 SET DIR("?",4)=" RR -> End Resp (#.86)"
End DoDot:1
+7 QUIT
