SROFILE ;BIR/MAM - EDIT SITE CONFIGURABLE FILES ;06/08/2011
;;3.0;Surgery;**48,41,88,100,175,176,182,184**;24 Jun 93;Build 35
START S SRO(1)="Surgery Transportation Devices^131.01",SRO(2)="Prosthesis^131.9",SRO(3)="Surgery Position^132",SRO(4)="Restraints and Positioning Aids^132.05",SRO(5)="Surgical Delay^132.4"
S SRO(6)="Monitors^133.4",SRO(7)="Irrigations^133.6",SRO(8)="Surgery Replacement Fluids^133.7",SRO(9)="Skin Prep Agents^135.1"
S SRO(10)="Skin Integrity^135.2",SRO(11)="Patient Mood^135.3",SRO(12)="Patient Consciousness^135.4",SRO(13)="Local Surgical Specialty^137.45",SRO(14)="Electroground Positions^138"
S SRO(15)="Special Equipment^131.3",SRO(16)="Planned Implant^131.5",SRO(17)="Pharmacy Items^131.06",SRO(18)="Special Instruments^131.02",SRO(19)="Special Supplies^131.04"
S SRLINE="" F I=1:1:80 S SRLINE=SRLINE_"="
DISPLAY W @IOF,!,SRLINE,!,?20,"Update Site Configurable Surgery Files",!,SRLINE
W !,"1. Surgery Transportation Devices",!,"2. Prosthesis",!,"3. Surgery Positions",!,"4. Restraints and Positional Aids"
W !,"5. Surgical Delay",!,"6. Monitors",!,"7. Irrigations",!,"8. Surgery Replacement Fluids",!,"9. Skin Prep Agents",!,"10. Skin Integrity",!,"11. Patient Mood"
W !,"12. Patient Consciousness",!,"13. Local Surgical Specialty",!,"14. Electroground Positions"
W !,"15. Special Equipment",!,"16. Planned Implant",!,"17. Pharmacy Items",!,"18. Special Instruments",!,"19. Special Supplies",!,SRLINE
ASK K DIR S DIR("?",1)="Enter the number corresponding to the file that you want to update. For",DIR("?",2)="example, enter ""8"" to enter, edit, or delete information contained in"
S DIR("?",3)="the Surgery Replacement Fluids file.",DIR("?",4)="",DIR("?",5)="NOTE: File entries you do not want to use should be made inactive and",DIR("?")="should NOT be deleted."
S DIR("A")="Update Information for which File ? ",DIR(0)="NOA^1:19" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y S SRSOUT=1 G END
S SRFILE=Y
S SRFNM=$P(SRO(SRFILE),"^"),SRFNUM=$P(SRO(SRFILE),"^",2) K SRO
W @IOF,!,"Update Information in the "_SRFNM_" file.",!,SRLINE
ENTRY W !! K DIC S (DLAYGO,DIC)=SRFNUM,DIC(0)="QEAMZL",SRF=SRFNUM
S SRP=3 I SRF=132!(SRF=135) S SRP=4
I SRF=132.05!(SRF=132.4)!(SRF=133.4)!(SRF=133.7) S SRP=2
I SRF=131.9 S SRP=6
S DIC("W")="I $P(^(0),""^"",SRP) W "" ** INACTIVE **"""
D ^DIC N SRHL,SRHLAD,SRHLIEN S:Y>0&((SRFILE=6)!(SRFILE=8)) SRHLIEN=+Y,SRHL=^SRO(SRF,SRHLIEN,0),SRHLAD=$P(Y,U,3) K DLAYGO I Y<0 G START
K DR S DIE=SRFNUM,DA=+Y S:SRFILE=2 DR=".01;1;2;5;6;7;8;9;10" S:SRFILE'=2 DR=".01:9999" D ^DIE D:(SRFILE=6)!(SRFILE=8) SRHL K DR,DIE,DA G ENTRY
G START
END W @IOF D ^SRSKILL
Q
SRHL ;HL7 master file update
N SRENT,SRHLST,SRTBL,FEC,REC
S FEC="UPD",SRTBL=$S(SRFILE=6:"MONITOR",SRFILE=8:"REPLACEMENT FLUID")_U_SRF_U_".01"
S SRENT=SRHLIEN_U_^SRO(SRF,SRHLIEN,0),SRHLST=$S(SRHLAD=1:"Addition",SRHL'=SRENT:"Updating",1:"") I $G(SRHLST)'="" D
.I $P(SRHL,U,2)="",'$P(SRHL,U,3),$P(SRENT,U,3)=1 S REC="MDC"
.I $P(SRHL,U,2)=1,'$P(SRHL,U,3),$P(SRENT,U,3)="" S REC="MAC"
.I $G(SRHLAD)=1 S REC="MAD"
.D:$D(REC) MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)
.I $G(SRHLAD)=1,$P(SRENT,U,2)=1 S REC="MDC" D MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)
K SRHLIEN,SRHL,SRHLAD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROFILE 3245 printed Apr 09, 2024@21:50:29 Page 2
SROFILE ;BIR/MAM - EDIT SITE CONFIGURABLE FILES ;06/08/2011
+1 ;;3.0;Surgery;**48,41,88,100,175,176,182,184**;24 Jun 93;Build 35
START SET SRO(1)="Surgery Transportation Devices^131.01"
SET SRO(2)="Prosthesis^131.9"
SET SRO(3)="Surgery Position^132"
SET SRO(4)="Restraints and Positioning Aids^132.05"
SET SRO(5)="Surgical Delay^132.4"
+1 SET SRO(6)="Monitors^133.4"
SET SRO(7)="Irrigations^133.6"
SET SRO(8)="Surgery Replacement Fluids^133.7"
SET SRO(9)="Skin Prep Agents^135.1"
+2 SET SRO(10)="Skin Integrity^135.2"
SET SRO(11)="Patient Mood^135.3"
SET SRO(12)="Patient Consciousness^135.4"
SET SRO(13)="Local Surgical Specialty^137.45"
SET SRO(14)="Electroground Positions^138"
+3 SET SRO(15)="Special Equipment^131.3"
SET SRO(16)="Planned Implant^131.5"
SET SRO(17)="Pharmacy Items^131.06"
SET SRO(18)="Special Instruments^131.02"
SET SRO(19)="Special Supplies^131.04"
+4 SET SRLINE=""
FOR I=1:1:80
SET SRLINE=SRLINE_"="
DISPLAY WRITE @IOF,!,SRLINE,!,?20,"Update Site Configurable Surgery Files",!,SRLINE
+1 WRITE !,"1. Surgery Transportation Devices",!,"2. Prosthesis",!,"3. Surgery Positions",!,"4. Restraints and Positional Aids"
+2 WRITE !,"5. Surgical Delay",!,"6. Monitors",!,"7. Irrigations",!,"8. Surgery Replacement Fluids",!,"9. Skin Prep Agents",!,"10. Skin Integrity",!,"11. Patient Mood"
+3 WRITE !,"12. Patient Consciousness",!,"13. Local Surgical Specialty",!,"14. Electroground Positions"
+4 WRITE !,"15. Special Equipment",!,"16. Planned Implant",!,"17. Pharmacy Items",!,"18. Special Instruments",!,"19. Special Supplies",!,SRLINE
ASK KILL DIR
SET DIR("?",1)="Enter the number corresponding to the file that you want to update. For"
SET DIR("?",2)="example, enter ""8"" to enter, edit, or delete information contained in"
+1 SET DIR("?",3)="the Surgery Replacement Fluids file."
SET DIR("?",4)=""
SET DIR("?",5)="NOTE: File entries you do not want to use should be made inactive and"
SET DIR("?")="should NOT be deleted."
+2 SET DIR("A")="Update Information for which File ? "
SET DIR(0)="NOA^1:19"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!'Y
SET SRSOUT=1
GOTO END
+3 SET SRFILE=Y
+4 SET SRFNM=$PIECE(SRO(SRFILE),"^")
SET SRFNUM=$PIECE(SRO(SRFILE),"^",2)
KILL SRO
+5 WRITE @IOF,!,"Update Information in the "_SRFNM_" file.",!,SRLINE
ENTRY WRITE !!
KILL DIC
SET (DLAYGO,DIC)=SRFNUM
SET DIC(0)="QEAMZL"
SET SRF=SRFNUM
+1 SET SRP=3
IF SRF=132!(SRF=135)
SET SRP=4
+2 IF SRF=132.05!(SRF=132.4)!(SRF=133.4)!(SRF=133.7)
SET SRP=2
+3 IF SRF=131.9
SET SRP=6
+4 SET DIC("W")="I $P(^(0),""^"",SRP) W "" ** INACTIVE **"""
+5 DO ^DIC
NEW SRHL,SRHLAD,SRHLIEN
if Y>0&((SRFILE=6)!(SRFILE=8))
SET SRHLIEN=+Y
SET SRHL=^SRO(SRF,SRHLIEN,0)
SET SRHLAD=$PIECE(Y,U,3)
KILL DLAYGO
IF Y<0
GOTO START
+6 KILL DR
SET DIE=SRFNUM
SET DA=+Y
if SRFILE=2
SET DR=".01;1;2;5;6;7;8;9;10"
if SRFILE'=2
SET DR=".01:9999"
DO ^DIE
if (SRFILE=6)!(SRFILE=8)
DO SRHL
KILL DR,DIE,DA
GOTO ENTRY
+7 GOTO START
END WRITE @IOF
DO ^SRSKILL
+1 QUIT
SRHL ;HL7 master file update
+1 NEW SRENT,SRHLST,SRTBL,FEC,REC
+2 SET FEC="UPD"
SET SRTBL=$SELECT(SRFILE=6:"MONITOR",SRFILE=8:"REPLACEMENT FLUID")_U_SRF_U_".01"
+3 SET SRENT=SRHLIEN_U_^SRO(SRF,SRHLIEN,0)
SET SRHLST=$SELECT(SRHLAD=1:"Addition",SRHL'=SRENT:"Updating",1:"")
IF $GET(SRHLST)'=""
Begin DoDot:1
+4 IF $PIECE(SRHL,U,2)=""
IF '$PIECE(SRHL,U,3)
IF $PIECE(SRENT,U,3)=1
SET REC="MDC"
+5 IF $PIECE(SRHL,U,2)=1
IF '$PIECE(SRHL,U,3)
IF $PIECE(SRENT,U,3)=""
SET REC="MAC"
+6 IF $GET(SRHLAD)=1
SET REC="MAD"
+7 if $DATA(REC)
DO MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)
+8 IF $GET(SRHLAD)=1
IF $PIECE(SRENT,U,2)=1
SET REC="MDC"
DO MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)
End DoDot:1
+9 KILL SRHLIEN,SRHL,SRHLAD
+10 QUIT
