source: FOIAVistA/trunk/r/SURGERY-SR/SROCODE.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1SROCODE ;BIR/MAM - SET UP FLAG FOR ANESTHESIA AGENTS ;01/30/08
2 ;;3.0; Surgery ;**72,41,114,151,166**;24 Jun 93;Build 6
3 ;
4 ; Reference to ENS^PSSGIU supported by DBIA #895
5 ;
61 N SRTEST S SRTEST=50,SRTEST(0)="AEQSZ",SRTEST("A")="Enter the name of the drug you wish to flag: "
7 D DIC^PSSDI(50,"SR",.SRTEST) G:+Y<1 DONE S SROIUDA=+Y,SROIRX=$P(Y,"^",2),SROIUX="S^SURGERY" D SROIU
8 G 1
9SROIU Q:'$D(SROIUDA)!'$D(SROIUX) Q:SROIUX'?1E1"^"1.E
10 N SRRX D DATA^PSS50(SROIUDA,,,,,"SRRX") S SRRX=$G(^TMP($J,"SRRX",SROIUDA,63)) D
11 .S SROIUY=$S($D(SRRX):SRRX,1:""),SROIUT=$P(SROIUX,"^",2),SROIUT=$E("N","AEIOU"[$E(SROIUT))_" "_SROIUT K ^TMP($J,"SRRX",SROIUDA)
12 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
13 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
14DONE W @IOF K SROIRX D ^SRSKILL
15 Q
16FLAG S PSIUDA=SROIUDA,PSIUX=SROIUX_"^1"
17 S X="PSSGIU" X ^%ZOSF("TEST") I $T D ENS^PSSGIU
18 ;HL7 master file update (addition) to anesthesia agent list
19 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)
20 ;A call to PDM to possibly generate an HL7 outgoing drug message
21 S X="PSSHUIDG" X ^%ZOSF("TEST") I $T D DRG^PSSHUIDG(PSIUDA)
22 K PSIUDA,PSIUX
23 Q
24OFF S PSIUDA=SROIUDA,PSIUX=SROIUX_"^1"
25 S X="PSSGIU" X ^%ZOSF("TEST") I $T D END^PSSGIU
26 ;HL7 master file update (deletion) to anesthesia agent list
27 N SRTBL,SRENT,FEC,REC S SRTBL="ANESTHESIA AGENT^50^.01",FEC="UPD",REC="MDL" D DATA^PSS50(SROIUDA,,,,,"SRRX")
28 S SRENT=SROIUDA_U_$P($G(^TMP($J,"SRRX",SROIUDA,.01)),"^") K ^TMP($J,"SRRX",SROIUDA) D MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)
29 ;A call to PDM to possibly generate an HL7 outgoing drug message
30 S X="PSSHUIDG" X ^%ZOSF("TEST") I $T D DRG^PSSHUIDG(PSIUDA)
31 K PSIUDA,PSIUX
32 Q
Note: See TracBrowser for help on using the repository browser.