Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROESNRA

SROESNRA.m

Go to the documentation of this file.
  1. SROESNRA ;BIR/ADM - NURSE REPORT E-SIG UTILITY ; [ 02/20/02 2:35 PM ]
  1. ;;3.0; Surgery ;**100**;24 Jun 93
  1. ;
  1. ;** NOTICE: This routine is part of an implementation of a nationally
  1. ;** controlled procedure. Local modifications to this routine
  1. ;** are prohibited.
  1. ;
  1. MULT ; process multiples
  1. 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
  1. S SRCAT=$P(SRFLD,"^"),SRSUB=$P(SRFLD,"^",2),SRFF=$P(SRSUB,"-",3)
  1. I SRFF="130.16,3"!(SRFF="130.028,.01")!(SRFF="130.164,.01") Q:'$P($G(^SRF(SRTN,"TIU")),"^",6)
  1. I SRFF["130.18" Q:'$P($G(^SRF(SRTN,"TIU")),"^",7)
  1. S SRNP=$P(SRFLD,"^",3),SRN=$P(SRNP,";"),SRP=$P(SRNP,";",2)
  1. K SRL F I=1:1 S Y=$P(SRN,",",I) Q:Y="" S SRL(I)=Y,SRL=I
  1. S SRW=$S($P(SRFF,";",2)["W":1,1:0)
  1. S SRE=0 F S SRE=$O(^SRF(SRTN,SRL(1),SRE)) Q:'SRE D
  1. .I SRL=2 D
  1. ..I SRS=1 D
  1. ...I $P(SRFF,",",2)=.01 S ^TMP("SRNSAVE",$J,SRTN,SRCAT,0)=$G(^SRF(SRTN,SRL(1),0))
  1. ...S ^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,0,SRSUB)=$P($G(^SRF(SRTN,SRL(1),SRE,SRL(2))),"^",SRP)
  1. ..I $P(SRSUB,"-")'["X" S ^TMP("SRNRAD"_SRS,$J,SRTN,SRCAT,SRE,0,SRSUB)=$P($G(^SRF(SRTN,SRL(1),SRE,SRL(2))),"^",SRP)
  1. .I SRL=3 S SRE1=0 F S SRE1=$O(^SRF(SRTN,SRL(1),SRE,SRL(2),SRE1)) Q:'SRE1 D
  1. ..I SRW D Q
  1. ...I SRS=1 D
  1. ....S ^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,0,SRSUB,0)=$G(^SRF(SRTN,SRL(1),SRE,SRL(2),0))
  1. ....S ^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,0,SRSUB,SRE1)=$P($G(^SRF(SRTN,SRL(1),SRE,SRL(2),SRE1,SRL(3))),"^",SRP)
  1. ...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)
  1. ..I SRS=1 D
  1. ...I $P(SRFF,",",2)=.01 S ^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,0,SRSUB)=$G(^SRF(SRTN,SRL(1),SRE,SRL(2),0))
  1. ...S ^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,SRE1,SRSUB)=$P($G(^SRF(SRTN,SRL(1),SRE,SRL(2),SRE1,SRL(3))),"^",SRP)
  1. ..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)
  1. Q
  1. REVRS ; restore pre-edit data in multiples
  1. D REMOVE
  1. S SRCAT="" F S SRCAT=$O(^TMP("SRNRMULT1",$J,SRTN,SRCAT)) Q:SRCAT="" D RESTORE
  1. Q
  1. RESTORE ; enter multiple data saved in ^TMP("SRNSAVE"
  1. 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
  1. .S SRSUB="" F S SRSUB=$O(^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,SRE1,SRSUB)) Q:SRSUB="" S SRCNT=SRCNT+1 D FIELD
  1. Q
  1. FIELD ; restore individual field
  1. S X=$P(SRSUB,"-",3),SRFILE=$P(X,","),Y=$P(X,",",2),SRFIELD=$P(Y,";"),SRW=$S($P(Y,";",2)["W":1,1:0)
  1. S:SRCNT=1 SRI="."_$P(SRFILE,".",2) S X=$E($P(SRSUB,"-"),1,2),SRJ=+X D REV^SROESNR1
  1. S SRNP=$P(SRFLD,"^",3),SRN=$P(SRNP,";"),SRP=$P(SRNP,";",2)
  1. K SRL F I=1:1 S Y=$P(SRN,",",I) Q:Y="" S SRL(I)=Y,SRL=I
  1. I 'SRW S SRVAL=^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,SRE1,SRSUB)
  1. K DA,DIE,DR
  1. I SRL=2,SRVAL'="" D
  1. .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
  1. .I SRE1=0,SRFIELD=.01 S ^SRF(SRTN,SRL(1),0)=^TMP("SRNSAVE",$J,SRTN,SRCAT,0)
  1. .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
  1. I SRL=3 D
  1. .I SRE1=0,SRFIELD=.01,SRVAL'="" S ^SRF(SRTN,SRL(1),SRE,SRL(2),0)=SRVAL Q
  1. .I SRW D Q
  1. ..S ^SRF(SRTN,SRL(1),SRE,SRL(2),0)=$G(^TMP("SRNSAVE",$J,SRTN,SRCAT,SRE,SRE1,SRSUB,0))
  1. ..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))
  1. .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
  1. Q
  1. REMOVE ; delete edited multiples
  1. 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
  1. .S SRSUB="",SRSUB=$O(^TMP("SRNRMULT1",$J,SRTN,SRCAT,SRE,SRE1,SRSUB))
  1. .S SRFF=$P(SRSUB,"-",3),SRK=$P(SRFF,","),SRI="."_$P(SRK,".",2),SRJ=1 D REV^SROESNR1
  1. .S SRNP=$P(SRFLD,"^",3),SRN=$P(SRNP,";"),SRP=$P(SRNP,";",2)
  1. .K SRL F I=1:1 S Y=$P(SRN,",",I) Q:Y="" S SRL(I)=Y,SRL=I
  1. .D DEL
  1. Q
  1. DEL ; delete all entries from multiple
  1. 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
  1. K ^SRF(SRTN,SRL(1))
  1. Q