- SROESNRA ;BIR/ADM - NURSE REPORT E-SIG UTILITY ; [ 02/20/02 2:35 PM ]
- ;;3.0; Surgery ;**100**;24 Jun 93
- ;
- ;** NOTICE: This routine is part of an implementation of a nationally
- ;** controlled procedure. Local modifications to this routine
- ;** are prohibited.
- ;
- MULT ; process multiples
- S X=$P(SRFLD,"^",2),Y=$P(SRFLD,"^",3) I $P(X,";")=0 S:SRS=1 ^TMP("SRNSAVE",$J,SRTN,$P(SRFLD,"^"),0)=$G(^SRF(SRTN,$P(Y,","),0)) Q
- S SRCAT=$P(SRFLD,"^"),SRSUB=$P(SRFLD,"^",2),SRFF=$P(SRSUB,"-",3)
- I SRFF="130.16,3"!(SRFF="130.028,.01")!(SRFF="130.164,.01") Q:'$P($G(^SRF(SRTN,"TIU")),"^",6)
- I SRFF["130.18" Q:'$P($G(^SRF(SRTN,"TIU")),"^",7)
- S SRNP=$P(SRFLD,"^",3),SRN=$P(SRNP,";"),SRP=$P(SRNP,";",2)
- K SRL F I=1:1 S Y=$P(SRN,",",I) Q:Y="" S SRL(I)=Y,SRL=I
- S SRW=$S($P(SRFF,";",2)["W":1,1:0)
- S SRE=0 F S SRE=$O(^SRF(SRTN,SRL(1),SRE)) Q:'SRE D
- .I SRL=2 D
- ..I SRS=1 D
- ...I $P(SRFF,",",2)=.01 S ^TMP("SRNSAVE",$J,SRTN,SRCAT,0)=$G(^SRF(SRTN,SRL(1),0))
- ...S ^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,0,SRSUB)=$P($G(^SRF(SRTN,SRL(1),SRE,SRL(2))),"^",SRP)
- ..I $P(SRSUB,"-")'["X" S ^TMP("SRNRAD"_SRS,$J,SRTN,SRCAT,SRE,0,SRSUB)=$P($G(^SRF(SRTN,SRL(1),SRE,SRL(2))),"^",SRP)
- .I SRL=3 S SRE1=0 F S SRE1=$O(^SRF(SRTN,SRL(1),SRE,SRL(2),SRE1)) Q:'SRE1 D
- ..I SRW D Q
- ...I SRS=1 D
- ....S ^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,0,SRSUB,0)=$G(^SRF(SRTN,SRL(1),SRE,SRL(2),0))
- ....S ^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,0,SRSUB,SRE1)=$P($G(^SRF(SRTN,SRL(1),SRE,SRL(2),SRE1,SRL(3))),"^",SRP)
- ...I $P(SRSUB,"-")'["X" S ^TMP("SRNRAD"_SRS,$J,SRTN,SRCAT,SRE,0,SRSUB,SRE1)=$P($G(^SRF(SRTN,SRL(1),SRE,SRL(2),SRE1,SRL(3))),"^",SRP)
- ..I SRS=1 D
- ...I $P(SRFF,",",2)=.01 S ^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,0,SRSUB)=$G(^SRF(SRTN,SRL(1),SRE,SRL(2),0))
- ...S ^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,SRE1,SRSUB)=$P($G(^SRF(SRTN,SRL(1),SRE,SRL(2),SRE1,SRL(3))),"^",SRP)
- ..I $P(SRSUB,"-")'["X" S ^TMP("SRNRAD"_SRS,$J,SRTN,SRCAT,SRE,SRE1,SRSUB)=$P($G(^SRF(SRTN,SRL(1),SRE,SRL(2),SRE1,SRL(3))),"^",SRP)
- Q
- REVRS ; restore pre-edit data in multiples
- D REMOVE
- S SRCAT="" F S SRCAT=$O(^TMP("SRNRMULT1",$J,SRTN,SRCAT)) Q:SRCAT="" D RESTORE
- Q
- RESTORE ; enter multiple data saved in ^TMP("SRNSAVE"
- S (SRCNT,SRE)=0 F S SRE=$O(^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE)) Q:'SRE S SRE1="" F S SRE1=$O(^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,SRE1)) Q:SRE1="" D
- .S SRSUB="" F S SRSUB=$O(^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,SRE1,SRSUB)) Q:SRSUB="" S SRCNT=SRCNT+1 D FIELD
- Q
- FIELD ; restore individual field
- S X=$P(SRSUB,"-",3),SRFILE=$P(X,","),Y=$P(X,",",2),SRFIELD=$P(Y,";"),SRW=$S($P(Y,";",2)["W":1,1:0)
- S:SRCNT=1 SRI="."_$P(SRFILE,".",2) S X=$E($P(SRSUB,"-"),1,2),SRJ=+X D REV^SROESNR1
- S SRNP=$P(SRFLD,"^",3),SRN=$P(SRNP,";"),SRP=$P(SRNP,";",2)
- K SRL F I=1:1 S Y=$P(SRN,",",I) Q:Y="" S SRL(I)=Y,SRL=I
- I 'SRW S SRVAL=^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,SRE1,SRSUB)
- K DA,DIE,DR
- I SRL=2,SRVAL'="" D
- .I SRL(1)=13,SRL(2)=2 S ^SRF(SRTN,13,SRE,2)=SRVAL K DA,DIK S DA(1)=SRTN,DA=SRE,DIK="^SRF("_SRTN_",13,",DIK(1)="3" D EN^DIK K DA,DIK Q
- .I SRE1=0,SRFIELD=.01 S ^SRF(SRTN,SRL(1),0)=^TMP("SRNSAVE",$J,SRTN,SRCAT,0)
- .S DA(1)=SRTN,DA=SRE,DIE="^SRF("_SRTN_","_$S(SRL(1):SRL(1),1:""""_SRL(1)_"""")_",",DR=SRFIELD_"////"_SRVAL D ^DIE K DA,DIE,DR
- I SRL=3 D
- .I SRE1=0,SRFIELD=.01,SRVAL'="" S ^SRF(SRTN,SRL(1),SRE,SRL(2),0)=SRVAL Q
- .I SRW D Q
- ..S ^SRF(SRTN,SRL(1),SRE,SRL(2),0)=$G(^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,SRE1,SRSUB,0))
- ..S SRLN=0 F S SRLN=$O(^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,SRE1,SRSUB,SRLN)) Q:'SRLN S ^SRF(SRTN,SRL(1),SRE,SRL(2),SRLN,0)=$G(^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,SRE1,SRSUB,SRLN))
- .I SRVAL'="" S DA(2)=SRTN,DA(1)=SRE,DA=SRE1,DIE="^SRF("_SRTN_","_$S(SRL(1):SRL(1),1:""""_SRL(1)_"""")_","_SRE_","_$S(SRL(2):SRL(2),1:""""_SRL(2)_"""")_",",DR=SRFIELD_"////"_SRVAL D ^DIE K DA,DIE,DR
- Q
- REMOVE ; delete edited multiples
- S SRCAT="" F S SRCAT=$O(^TMP("SRNRMULT1",$J,SRTN,SRCAT)) Q:SRCAT="" S SRE=$O(^TMP("SRNRMULT1",$J,SRTN,SRCAT,0)) Q:'SRE S SRE1="",SRE1=$O(^TMP("SRNRMULT1",$J,SRTN,SRCAT,SRE,SRE1)) Q:SRE1="" D
- .S SRSUB="",SRSUB=$O(^TMP("SRNRMULT1",$J,SRTN,SRCAT,SRE,SRE1,SRSUB))
- .S SRFF=$P(SRSUB,"-",3),SRK=$P(SRFF,","),SRI="."_$P(SRK,".",2),SRJ=1 D REV^SROESNR1
- .S SRNP=$P(SRFLD,"^",3),SRN=$P(SRNP,";"),SRP=$P(SRNP,";",2)
- .K SRL F I=1:1 S Y=$P(SRN,",",I) Q:Y="" S SRL(I)=Y,SRL=I
- .D DEL
- Q
- DEL ; delete all entries from multiple
- K DA,DIK S SRIEN=0 F S SRIEN=$O(^SRF(SRTN,SRL(1),SRIEN)) Q:'SRIEN S DA(1)=SRTN,DA=SRIEN,DIK="^SRF("_DA(1)_","_$S(SRL(1):SRL(1),1:""""_SRL(1)_"""")_"," D ^DIK K DA,DIK
- K ^SRF(SRTN,SRL(1))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROESNRA 4574 printed Jan 18, 2025@03:44:46 Page 2
- SROESNRA ;BIR/ADM - NURSE REPORT E-SIG UTILITY ; [ 02/20/02 2:35 PM ]
- +1 ;;3.0; Surgery ;**100**;24 Jun 93
- +2 ;
- +3 ;** NOTICE: This routine is part of an implementation of a nationally
- +4 ;** controlled procedure. Local modifications to this routine
- +5 ;** are prohibited.
- +6 ;
- MULT ; process multiples
- +1 SET X=$PIECE(SRFLD,"^",2)
- SET Y=$PIECE(SRFLD,"^",3)
- IF $PIECE(X,";")=0
- if SRS=1
- SET ^TMP("SRNSAVE",$JOB,SRTN,$PIECE(SRFLD,"^"),0)=$GET(^SRF(SRTN,$PIECE(Y,","),0))
- QUIT
- +2 SET SRCAT=$PIECE(SRFLD,"^")
- SET SRSUB=$PIECE(SRFLD,"^",2)
- SET SRFF=$PIECE(SRSUB,"-",3)
- +3 IF SRFF="130.16,3"!(SRFF="130.028,.01")!(SRFF="130.164,.01")
- if '$PIECE($GET(^SRF(SRTN,"TIU")),"^",6)
- QUIT
- +4 IF SRFF["130.18"
- if '$PIECE($GET(^SRF(SRTN,"TIU")),"^",7)
- QUIT
- +5 SET SRNP=$PIECE(SRFLD,"^",3)
- SET SRN=$PIECE(SRNP,";")
- SET SRP=$PIECE(SRNP,";",2)
- +6 KILL SRL
- FOR I=1:1
- SET Y=$PIECE(SRN,",",I)
- if Y=""
- QUIT
- SET SRL(I)=Y
- SET SRL=I
- +7 SET SRW=$SELECT($PIECE(SRFF,";",2)["W":1,1:0)
- +8 SET SRE=0
- FOR
- SET SRE=$ORDER(^SRF(SRTN,SRL(1),SRE))
- if 'SRE
- QUIT
- Begin DoDot:1
- +9 IF SRL=2
- Begin DoDot:2
- +10 IF SRS=1
- Begin DoDot:3
- +11 IF $PIECE(SRFF,",",2)=.01
- SET ^TMP("SRNSAVE",$JOB,SRTN,SRCAT,0)=$GET(^SRF(SRTN,SRL(1),0))
- +12 SET ^TMP("SRNSAVE",$JOB,SRTN,SRCAT,SRE,0,SRSUB)=$PIECE($GET(^SRF(SRTN,SRL(1),SRE,SRL(2))),"^",SRP)
- End DoDot:3
- +13 IF $PIECE(SRSUB,"-")'["X"
- SET ^TMP("SRNRAD"_SRS,$JOB,SRTN,SRCAT,SRE,0,SRSUB)=$PIECE($GET(^SRF(SRTN,SRL(1),SRE,SRL(2))),"^",SRP)
- End DoDot:2
- +14 IF SRL=3
- SET SRE1=0
- FOR
- SET SRE1=$ORDER(^SRF(SRTN,SRL(1),SRE,SRL(2),SRE1))
- if 'SRE1
- QUIT
- Begin DoDot:2
- +15 IF SRW
- Begin DoDot:3
- +16 IF SRS=1
- Begin DoDot:4
- +17 SET ^TMP("SRNSAVE",$JOB,SRTN,SRCAT,SRE,0,SRSUB,0)=$GET(^SRF(SRTN,SRL(1),SRE,SRL(2),0))
- +18 SET ^TMP("SRNSAVE",$JOB,SRTN,SRCAT,SRE,0,SRSUB,SRE1)=$PIECE($GET(^SRF(SRTN,SRL(1),SRE,SRL(2),SRE1,SRL(3))),"^",SRP)
- End DoDot:4
- +19 IF $PIECE(SRSUB,"-")'["X"
- SET ^TMP("SRNRAD"_SRS,$JOB,SRTN,SRCAT,SRE,0,SRSUB,SRE1)=$PIECE($GET(^SRF(SRTN,SRL(1),SRE,SRL(2),SRE1,SRL(3))),"^",SRP)
- End DoDot:3
- QUIT
- +20 IF SRS=1
- Begin DoDot:3
- +21 IF $PIECE(SRFF,",",2)=.01
- SET ^TMP("SRNSAVE",$JOB,SRTN,SRCAT,SRE,0,SRSUB)=$GET(^SRF(SRTN,SRL(1),SRE,SRL(2),0))
- +22 SET ^TMP("SRNSAVE",$JOB,SRTN,SRCAT,SRE,SRE1,SRSUB)=$PIECE($GET(^SRF(SRTN,SRL(1),SRE,SRL(2),SRE1,SRL(3))),"^",SRP)
- End DoDot:3
- +23 IF $PIECE(SRSUB,"-")'["X"
- SET ^TMP("SRNRAD"_SRS,$JOB,SRTN,SRCAT,SRE,SRE1,SRSUB)=$PIECE($GET(^SRF(SRTN,SRL(1),SRE,SRL(2),SRE1,SRL(3))),"^",SRP)
- End DoDot:2
- End DoDot:1
- +24 QUIT
- REVRS ; restore pre-edit data in multiples
- +1 DO REMOVE
- +2 SET SRCAT=""
- FOR
- SET SRCAT=$ORDER(^TMP("SRNRMULT1",$JOB,SRTN,SRCAT))
- if SRCAT=""
- QUIT
- DO RESTORE
- +3 QUIT
- RESTORE ; enter multiple data saved in ^TMP("SRNSAVE"
- +1 SET (SRCNT,SRE)=0
- FOR
- SET SRE=$ORDER(^TMP("SRNSAVE",$JOB,SRTN,SRCAT,SRE))
- if 'SRE
- QUIT
- SET SRE1=""
- FOR
- SET SRE1=$ORDER(^TMP("SRNSAVE",$JOB,SRTN,SRCAT,SRE,SRE1))
- if SRE1=""
- QUIT
- Begin DoDot:1
- +2 SET SRSUB=""
- FOR
- SET SRSUB=$ORDER(^TMP("SRNSAVE",$JOB,SRTN,SRCAT,SRE,SRE1,SRSUB))
- if SRSUB=""
- QUIT
- SET SRCNT=SRCNT+1
- DO FIELD
- End DoDot:1
- +3 QUIT
- FIELD ; restore individual field
- +1 SET X=$PIECE(SRSUB,"-",3)
- SET SRFILE=$PIECE(X,",")
- SET Y=$PIECE(X,",",2)
- SET SRFIELD=$PIECE(Y,";")
- SET SRW=$SELECT($PIECE(Y,";",2)["W":1,1:0)
- +2 if SRCNT=1
- SET SRI="."_$PIECE(SRFILE,".",2)
- SET X=$EXTRACT($PIECE(SRSUB,"-"),1,2)
- SET SRJ=+X
- DO REV^SROESNR1
- +3 SET SRNP=$PIECE(SRFLD,"^",3)
- SET SRN=$PIECE(SRNP,";")
- SET SRP=$PIECE(SRNP,";",2)
- +4 KILL SRL
- FOR I=1:1
- SET Y=$PIECE(SRN,",",I)
- if Y=""
- QUIT
- SET SRL(I)=Y
- SET SRL=I
- +5 IF 'SRW
- SET SRVAL=^TMP("SRNSAVE",$JOB,SRTN,SRCAT,SRE,SRE1,SRSUB)
- +6 KILL DA,DIE,DR
- +7 IF SRL=2
- IF SRVAL'=""
- Begin DoDot:1
- +8 IF SRL(1)=13
- IF SRL(2)=2
- SET ^SRF(SRTN,13,SRE,2)=SRVAL
- KILL DA,DIK
- SET DA(1)=SRTN
- SET DA=SRE
- SET DIK="^SRF("_SRTN_",13,"
- SET DIK(1)="3"
- DO EN^DIK
- KILL DA,DIK
- QUIT
- +9 IF SRE1=0
- IF SRFIELD=.01
- SET ^SRF(SRTN,SRL(1),0)=^TMP("SRNSAVE",$JOB,SRTN,SRCAT,0)
- +10 SET DA(1)=SRTN
- SET DA=SRE
- SET DIE="^SRF("_SRTN_","_$SELECT(SRL(1):SRL(1),1:""""_SRL(1)_"""")_","
- SET DR=SRFIELD_"////"_SRVAL
- DO ^DIE
- KILL DA,DIE,DR
- End DoDot:1
- +11 IF SRL=3
- Begin DoDot:1
- +12 IF SRE1=0
- IF SRFIELD=.01
- IF SRVAL'=""
- SET ^SRF(SRTN,SRL(1),SRE,SRL(2),0)=SRVAL
- QUIT
- +13 IF SRW
- Begin DoDot:2
- +14 SET ^SRF(SRTN,SRL(1),SRE,SRL(2),0)=$GET(^TMP("SRNSAVE",$JOB,SRTN,SRCAT,SRE,SRE1,SRSUB,0))
- +15 SET SRLN=0
- FOR
- SET SRLN=$ORDER(^TMP("SRNSAVE",$JOB,SRTN,SRCAT,SRE,SRE1,SRSUB,SRLN))
- if 'SRLN
- QUIT
- SET ^SRF(SRTN,SRL(1),SRE,SRL(2),SRLN,0)=$GET(^TMP("SRNSAVE",$JOB,SRTN,SRCAT,SRE,SRE1,SRSUB,SRLN))
- End DoDot:2
- QUIT
- +16 IF SRVAL'=""
- SET DA(2)=SRTN
- SET DA(1)=SRE
- SET DA=SRE1
- SET DIE="^SRF("_SRTN_","_$SELECT(SRL(1):SRL(1),1:""""_SRL(1)_"""")_","_SRE_","_$SELECT(SRL(2):SRL(2),1:""""_SRL(2)_"""")_","
- SET DR=SRFIELD_"////"_SRVAL
- DO ^DIE
- KILL DA,DIE,DR
- End DoDot:1
- +17 QUIT
- REMOVE ; delete edited multiples
- +1 SET SRCAT=""
- FOR
- SET SRCAT=$ORDER(^TMP("SRNRMULT1",$JOB,SRTN,SRCAT))
- if SRCAT=""
- QUIT
- SET SRE=$ORDER(^TMP("SRNRMULT1",$JOB,SRTN,SRCAT,0))
- if 'SRE
- QUIT
- SET SRE1=""
- SET SRE1=$ORDER(^TMP("SRNRMULT1",$JOB,SRTN,SRCAT,SRE,SRE1))
- if SRE1=""
- QUIT
- Begin DoDot:1
- +2 SET SRSUB=""
- SET SRSUB=$ORDER(^TMP("SRNRMULT1",$JOB,SRTN,SRCAT,SRE,SRE1,SRSUB))
- +3 SET SRFF=$PIECE(SRSUB,"-",3)
- SET SRK=$PIECE(SRFF,",")
- SET SRI="."_$PIECE(SRK,".",2)
- SET SRJ=1
- DO REV^SROESNR1
- +4 SET SRNP=$PIECE(SRFLD,"^",3)
- SET SRN=$PIECE(SRNP,";")
- SET SRP=$PIECE(SRNP,";",2)
- +5 KILL SRL
- FOR I=1:1
- SET Y=$PIECE(SRN,",",I)
- if Y=""
- QUIT
- SET SRL(I)=Y
- SET SRL=I
- +6 DO DEL
- End DoDot:1
- +7 QUIT
- DEL ; delete all entries from multiple
- +1 KILL DA,DIK
- SET SRIEN=0
- FOR
- SET SRIEN=$ORDER(^SRF(SRTN,SRL(1),SRIEN))
- if 'SRIEN
- QUIT
- SET DA(1)=SRTN
- SET DA=SRIEN
- SET DIK="^SRF("_DA(1)_","_$SELECT(SRL(1):SRL(1),1:""""_SRL(1)_"""")_","
- DO ^DIK
- KILL DA,DIK
- +2 KILL ^SRF(SRTN,SRL(1))
- +3 QUIT