- SRHLSCRN ;B'HAM ISC/DLR - Surgery Interface Menu to initial field settings ; [ 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 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
- 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
- SRHLSCRN ;B'HAM ISC/DLR - Surgery Interface Menu to initial field settings ; [ 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 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
- +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