SROCODE ;BIR/MAM - SET UP FLAG FOR ANESTHESIA AGENTS ;01/30/08
;;3.0; Surgery ;**72,41,114,151,166**;24 Jun 93;Build 6
;
; Reference to ENS^PSSGIU supported by DBIA #895
;
1 N SRTEST S SRTEST=50,SRTEST(0)="AEQSZ",SRTEST("A")="Enter the name of the drug you wish to flag: "
D DIC^PSSDI(50,"SR",.SRTEST) G:+Y<1 DONE S SROIUDA=+Y,SROIRX=$P(Y,"^",2),SROIUX="S^SURGERY" D SROIU
G 1
SROIU Q:'$D(SROIUDA)!'$D(SROIUX) Q:SROIUX'?1E1"^"1.E
N SRRX D DATA^PSS50(SROIUDA,,,,,"SRRX") S SRRX=$G(^TMP($J,"SRRX",SROIUDA,63)) D
.S SROIUY=$S($D(SRRX):SRRX,1:""),SROIUT=$P(SROIUX,"^",2),SROIUT=$E("N","AEIOU"[$E(SROIUT))_" "_SROIUT K ^TMP($J,"SRRX",SROIUDA)
I SROIUY["S" W !!,"This drug is already flagged for SURGERY." K DIR S DIR("A")="Do you want to remove the flag (Y/N)",DIR(0)="Y" D ^DIR D:Y OFF D DONE Q
W !! K DIR S DIR("A")="Do you want to flag this drug for SURGERY (Y/N)",DIR(0)="Y" D ^DIR D:Y FLAG
DONE W @IOF K SROIRX D ^SRSKILL
Q
FLAG S PSIUDA=SROIUDA,PSIUX=SROIUX_"^1"
S X="PSSGIU" X ^%ZOSF("TEST") I $T D ENS^PSSGIU
;HL7 master file update (addition) to anesthesia agent list
N SRTBL,SRENT,FEC,REC S SRTBL="ANESTHESIA AGENT^50^.01",FEC="UPD",REC="MAD",SRENT=SROIUDA_U_SROIRX D MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)
;A call to PDM to possibly generate an HL7 outgoing drug message
S X="PSSHUIDG" X ^%ZOSF("TEST") I $T D DRG^PSSHUIDG(PSIUDA)
K PSIUDA,PSIUX
Q
OFF S PSIUDA=SROIUDA,PSIUX=SROIUX_"^1"
S X="PSSGIU" X ^%ZOSF("TEST") I $T D END^PSSGIU
;HL7 master file update (deletion) to anesthesia agent list
N SRTBL,SRENT,FEC,REC S SRTBL="ANESTHESIA AGENT^50^.01",FEC="UPD",REC="MDL" D DATA^PSS50(SROIUDA,,,,,"SRRX")
S SRENT=SROIUDA_U_$P($G(^TMP($J,"SRRX",SROIUDA,.01)),"^") K ^TMP($J,"SRRX",SROIUDA) D MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)
;A call to PDM to possibly generate an HL7 outgoing drug message
S X="PSSHUIDG" X ^%ZOSF("TEST") I $T D DRG^PSSHUIDG(PSIUDA)
K PSIUDA,PSIUX
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROCODE 1924 printed Nov 22, 2024@17:52:52 Page 2
SROCODE ;BIR/MAM - SET UP FLAG FOR ANESTHESIA AGENTS ;01/30/08
+1 ;;3.0; Surgery ;**72,41,114,151,166**;24 Jun 93;Build 6
+2 ;
+3 ; Reference to ENS^PSSGIU supported by DBIA #895
+4 ;
1 NEW SRTEST
SET SRTEST=50
SET SRTEST(0)="AEQSZ"
SET SRTEST("A")="Enter the name of the drug you wish to flag: "
+1 DO DIC^PSSDI(50,"SR",.SRTEST)
if +Y<1
GOTO DONE
SET SROIUDA=+Y
SET SROIRX=$PIECE(Y,"^",2)
SET SROIUX="S^SURGERY"
DO SROIU
+2 GOTO 1
SROIU if '$DATA(SROIUDA)!'$DATA(SROIUX)
QUIT
if SROIUX'?1E1"^"1.E
QUIT
+1 NEW SRRX
DO DATA^PSS50(SROIUDA,,,,,"SRRX")
SET SRRX=$GET(^TMP($JOB,"SRRX",SROIUDA,63))
Begin DoDot:1
+2 SET SROIUY=$SELECT($DATA(SRRX):SRRX,1:"")
SET SROIUT=$PIECE(SROIUX,"^",2)
SET SROIUT=$EXTRACT("N","AEIOU"[$EXTRACT(SROIUT))_" "_SROIUT
KILL ^TMP($JOB,"SRRX",SROIUDA)
End DoDot:1
+3 IF SROIUY["S"
WRITE !!,"This drug is already flagged for SURGERY."
KILL DIR
SET DIR("A")="Do you want to remove the flag (Y/N)"
SET DIR(0)="Y"
DO ^DIR
if Y
DO OFF
DO DONE
QUIT
+4 WRITE !!
KILL DIR
SET DIR("A")="Do you want to flag this drug for SURGERY (Y/N)"
SET DIR(0)="Y"
DO ^DIR
if Y
DO FLAG
DONE WRITE @IOF
KILL SROIRX
DO ^SRSKILL
+1 QUIT
FLAG SET PSIUDA=SROIUDA
SET PSIUX=SROIUX_"^1"
+1 SET X="PSSGIU"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO ENS^PSSGIU
+2 ;HL7 master file update (addition) to anesthesia agent list
+3 NEW SRTBL,SRENT,FEC,REC
SET SRTBL="ANESTHESIA AGENT^50^.01"
SET FEC="UPD"
SET REC="MAD"
SET SRENT=SROIUDA_U_SROIRX
DO MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)
+4 ;A call to PDM to possibly generate an HL7 outgoing drug message
+5 SET X="PSSHUIDG"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO DRG^PSSHUIDG(PSIUDA)
+6 KILL PSIUDA,PSIUX
+7 QUIT
OFF SET PSIUDA=SROIUDA
SET PSIUX=SROIUX_"^1"
+1 SET X="PSSGIU"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO END^PSSGIU
+2 ;HL7 master file update (deletion) to anesthesia agent list
+3 NEW SRTBL,SRENT,FEC,REC
SET SRTBL="ANESTHESIA AGENT^50^.01"
SET FEC="UPD"
SET REC="MDL"
DO DATA^PSS50(SROIUDA,,,,,"SRRX")
+4 SET SRENT=SROIUDA_U_$PIECE($GET(^TMP($JOB,"SRRX",SROIUDA,.01)),"^")
KILL ^TMP($JOB,"SRRX",SROIUDA)
DO MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)
+5 ;A call to PDM to possibly generate an HL7 outgoing drug message
+6 SET X="PSSHUIDG"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO DRG^PSSHUIDG(PSIUDA)
+7 KILL PSIUDA,PSIUX
+8 QUIT
