PSSMRTUP ;BIR/RTR-Process Standard Medication Route File Updates ;03/02/09
;;1.0;PHARMACY DATA MANAGEMENT;**147**;9/30/97;Build 16
;
;Reference to TMP("XUMF EVENT" supported by DBIA 5470
EN ;
I '$D(^TMP("XUMF EVENT",$J,51.23)) Q
;We are assuming the name of the .01 field will not change
K ^TMP($J,"PSSMRPTX") K ^TMP($J,"PSSMRPCC") K ^TMP($J,"PSSMRUN")
N PSSMRPCT
S PSSMRPCT=1
D NWRT
D STCH
D INACZ^PSSMRTUX
D LOCALS
D MAIL K ^TMP($J,"PSSMRPCC") K ^TMP($J,"PSSMRUN") K ^TMP($J,"PSSMRPTX")
Q
;
;
MAIL ;
N XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMYBLOB,XMZ,XMDUN
I '$D(^TMP($J,"PSSMRPTX")) Q
S XMSUB="Standard Medication Route File Update"
S XMDUZ="Standard Medication Route File Processor"
S XMTEXT="^TMP($J,""PSSMRPTX"","
S XMY("G.PSS ORDER CHECKS")=""
N DIFROM D ^XMD
;K ^TMP($J,"PSSMRPTX")
Q
;
;
STAT(PSSMRPEN) ;Return status of entry, assuming .01 and File 51.23
I $P($$GETSTAT^XTID(51.23,.01,PSSMRPEN_","),"^")=1 Q 1
Q 0
;
;
NWRT ;New Medication Routes
N PSSMRPL,PSSMRPLN,PSSMRPL1,PSSMRPST S PSSMRPL1=0
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="The following entries have been added to the Standard Medication Routes",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="(#51.23) File:",PSSMRPCT=PSSMRPCT+1 S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" ",PSSMRPCT=PSSMRPCT+1
F PSSMRPL=0:0 S PSSMRPL=$O(^TMP("XUMF EVENT",$J,51.23,"NEW",PSSMRPL)) Q:'PSSMRPL D
.S PSSMRPLN=$G(^PS(51.23,PSSMRPL,0)) I PSSMRPLN="" Q
.S PSSMRPL1=1,PSSMRPST=$$STAT(PSSMRPL)
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" "_$P(PSSMRPLN,"^")_$S('PSSMRPST:" (Inactive)",1:"") S PSSMRPCT=PSSMRPCT+1
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" FDB Route: "_$S($P(PSSMRPLN,"^",2)'="":$P(PSSMRPLN,"^",2),1:"(None)") S PSSMRPCT=PSSMRPCT+1
I 'PSSMRPL1 S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" (None)" S PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" " S PSSMRPCT=PSSMRPCT+1
Q
;
;
STCH ;Status changes
;Sets PSSMRPCC TMP global, which holds inactivated and reactivated entries
;If 0.1 changes, which it should not, we are just showing the 'after' value
N PSSMRPBB,PSSMRPDD,PSSMRPEE,PSSMRPFF,PSSMRPGG,PSSMRPXX,PSSMRPZZ,PSSMRPLL,PSSMRPZA,PSSMRPZB
S PSSMRPFF=0
F PSSMRPLL=0:0 S PSSMRPLL=$O(^TMP("XUMF EVENT",$J,51.23,"STATUS",PSSMRPLL)) Q:'PSSMRPLL D
.S PSSMRPBB=$G(^TMP("XUMF EVENT",$J,51.23,"STATUS",PSSMRPLL))
.I PSSMRPBB="" Q
.I $P(PSSMRPBB,"^",3)'=0,$P(PSSMRPBB,"^",3)'=1 Q
.S PSSMRPZA=$$RPLCMNT^XTIDTRM(51.23,PSSMRPLL) S PSSMRPZB=$P(PSSMRPZA,";") S ^TMP($J,"PSSMRPCC",$S($P(PSSMRPBB,"^",3)=0:"INACT",1:"REACT"),PSSMRPLL)=$S('PSSMRPZB:0,PSSMRPZB=PSSMRPLL:0,1:PSSMRPZB)
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="The following entries have been inactivated in the Standard Medication",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="Routes (#51.23) File:",PSSMRPCT=PSSMRPCT+1 S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" ",PSSMRPCT=PSSMRPCT+1
K PSSMRPLL
F PSSMRPLL=0:0 S PSSMRPLL=$O(^TMP($J,"PSSMRPCC","INACT",PSSMRPLL)) Q:'PSSMRPLL D
.S PSSMRPXX=+PSSMRPLL_"," I '$$SCREEN^XTID(51.23,.01,PSSMRPXX) K ^TMP($J,"PSSMRPCC","INACT",PSSMRPLL) Q
.S PSSMRPFF=1 S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" "_$P($G(^PS(51.23,+PSSMRPLL,0)),"^") S PSSMRPCT=PSSMRPCT+1
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" FDB Route: "_$S($P($G(^PS(51.23,+PSSMRPLL,0)),"^",2)'="":$P($G(^PS(51.23,+PSSMRPLL,0)),"^",2),1:"(None)") S PSSMRPCT=PSSMRPCT+1
.S PSSMRPDD=$G(^TMP($J,"PSSMRPCC","INACT",PSSMRPLL))
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" Replacement Term: "_$S(+$G(PSSMRPDD):$P($G(^PS(51.23,+PSSMRPDD,0)),"^"),1:"(None)") S PSSMRPCT=PSSMRPCT+1
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" Replacement Term FDB Route: "_$S('$G(PSSMRPDD):"(None)",$P($G(^PS(51.23,+PSSMRPDD,0)),"^",2)'="":$P($G(^PS(51.23,+PSSMRPDD,0)),"^",2),1:"(None)") S PSSMRPCT=PSSMRPCT+1
I 'PSSMRPFF S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" (None)",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" " S PSSMRPCT=PSSMRPCT+1
S PSSMRPGG=0
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="The following entries have been reactivated in the Standard Medication",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="Routes (#51.23) File:",PSSMRPCT=PSSMRPCT+1 S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" ",PSSMRPCT=PSSMRPCT+1
F PSSMRPEE=0:0 S PSSMRPEE=$O(^TMP($J,"PSSMRPCC","REACT",PSSMRPEE)) Q:'PSSMRPEE D
.S PSSMRPZZ=+PSSMRPEE_"," I $$SCREEN^XTID(51.23,.01,PSSMRPZZ) K ^TMP($J,"PSSMRPCC","REACT",PSSMRPEE) Q
.S PSSMRPGG=1 S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" "_$P($G(^PS(51.23,+PSSMRPEE,0)),"^") S PSSMRPCT=PSSMRPCT+1
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" FDB Route: "_$S($P($G(^PS(51.23,+PSSMRPEE,0)),"^",2)'="":$P($G(^PS(51.23,+PSSMRPEE,0)),"^",2),1:"(None)") S PSSMRPCT=PSSMRPCT+1
I 'PSSMRPGG S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" (None)",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" " S PSSMRPCT=PSSMRPCT+1
Q
;
;
LOCALS ;
;Loop through 51.2, call INCT to see if entry is in INACT Global, if so, then unmap local entry, then Remap if there is a replacement entry
;Then if local entry is still unmapped, execute standard Med Route mapping logic
;INCT and SET will set the PSSMRUN TMP global as follows, where piece 1 one = 1 for Mapped/Remapped, or = 0 for unmapped
;TMP($J,"PSSMRUN",Lock variable,51.2 IEN)=0 or 1^Old Mapped Name^New Mapped Name
D REMAP
Q
;
;
REMAP ;Attempt to remap any unmapped local medication routes
N PSSRTIEN,PSSRTNAM,PSSRTSTS,PSSRTIX,PSSRTLOC,PSSRTLOP,PSSRTLOX,PSSRTSHL
S PSSRTIX="" F S PSSRTIX=$O(^PS(51.2,"B",PSSRTIX)) Q:PSSRTIX="" D
.F PSSRTIEN=0:0 S PSSRTIEN=$O(^PS(51.2,"B",PSSRTIX,PSSRTIEN)) Q:'PSSRTIEN D
..I '$D(^PS(51.2,PSSRTIEN,0)) Q
..;I '$P($G(^PS(51.2,PSSRTIEN,0)),"^",4) Q
..S PSSRTLOC=0 L +^PS(51.2,PSSRTIEN):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T S PSSRTLOC=1
..;Continue if record is locked, just do not set any data
..D INCT I $P($G(^PS(51.2,PSSRTIEN,1)),"^"),'$D(^TMP($J,"PSSMRPCC","INACT",+$P($G(^PS(51.2,PSSRTIEN,1)),"^"))) D UN Q
..K PSSRTNAM,PSSRTSTS I '$P($G(^PS(51.2,PSSRTIEN,0)),"^",4) D UN Q
..S PSSRTNAM=$P($G(^PS(51.2,PSSRTIEN,0)),"^") S PSSRTNAM=$$UP^XLFSTR(PSSRTNAM)
..S PSSRTSTS=$O(^PS(51.23,"B",PSSRTNAM,0)) I PSSRTSTS,'$$SCREEN^XTID(51.23,.01,PSSRTSTS_",") D SET D UN Q
..K PSSRTSTS,PSSRTSHL S PSSRTLOX=0 F PSSRTLOP=0:0 S PSSRTLOP=$O(^PS(51.23,"C",PSSRTNAM,PSSRTLOP)) Q:'PSSRTLOP S PSSRTSTS=PSSRTLOP I PSSRTSTS,'$$SCREEN^XTID(51.23,.01,PSSRTSTS_",") S PSSRTLOX=PSSRTLOX+1 S PSSRTSHL=PSSRTSTS
..I PSSRTLOX=1 S PSSRTSTS=PSSRTSHL D SET D UN Q
..K PSSRTSTS I PSSRTNAM[" EAR" S PSSRTSTS=$O(^PS(51.23,"B","OTIC",0)) I PSSRTSTS,'$$SCREEN^XTID(51.23,.01,PSSRTSTS_",") D SET D UN Q
..K PSSRTSTS I PSSRTNAM[" EYE" S PSSRTSTS=$O(^PS(51.23,"B","OPHTHALMIC",0)) I PSSRTSTS,'$$SCREEN^XTID(51.23,.01,PSSRTSTS_",") D SET D UN Q
..K PSSRTSTS I PSSRTNAM="G TUBE"!(PSSRTNAM="G-TUBE")!(PSSRTNAM="J TUBE")!(PSSRTNAM="J-TUBE")!(PSSRTNAM="NG TUBE")!(PSSRTNAM="NG-TUBE") D I PSSRTSTS,'$$SCREEN^XTID(51.23,.01,PSSRTSTS_",") D SET D UN Q
...S PSSRTSTS=$O(^PS(51.23,"B","ENTERAL",0))
..K PSSRTSTS I PSSRTNAM="BY MOUTH" S PSSRTSTS=$O(^PS(51.23,"B","ORAL",0)) I PSSRTSTS,'$$SCREEN^XTID(51.23,.01,PSSRTSTS_",") D SET D UN Q
..K PSSRTSTS I PSSRTNAM["NOSE"!(PSSRTNAM["NASAL")!(PSSRTNAM["NOSTRIL") S PSSRTSTS=$O(^PS(51.23,"B","NASAL",0)) I PSSRTSTS,'$$SCREEN^XTID(51.23,.01,PSSRTSTS_",") D SET D UN Q
..K PSSRTSTS I PSSRTNAM="IVPB"!(PSSRTNAM="IV PUSH")!(PSSRTNAM="IV PIGGYBACK") S PSSRTSTS=$O(^PS(51.23,"B","INTRAVENOUS",0)) I PSSRTSTS,'$$SCREEN^XTID(51.23,.01,PSSRTSTS_",") D SET D UN Q
..D UN
D FINAL
Q
;
;
UN ;Unlock Med Route
I PSSRTLOC Q
L -^PS(51.2,PSSRTIEN)
Q
;
;
SET ;Set Data, leaving USER as null, so the installer is not recorded as the user
I '$D(^TMP($J,"PSSMRUN",$S(PSSRTLOC:"PSSLCK",1:"PSSUNLCK"),PSSRTIEN)) S ^TMP($J,"PSSMRUN",$S(PSSRTLOC:"PSSLCK",1:"PSSUNLCK"),PSSRTIEN)=1_"^^"_$P($G(^PS(51.23,PSSRTSTS,0)),"^") D OLDNM G SETPS
S $P(^TMP($J,"PSSMRUN",$S(PSSRTLOC:"PSSLCK",1:"PSSUNLCK"),PSSRTIEN),"^",3)=$P($G(^PS(51.23,PSSRTSTS,0)),"^"),$P(^TMP($J,"PSSMRUN",$S(PSSRTLOC:"PSSLCK",1:"PSSUNLCK"),PSSRTIEN),"^")=1 D OLDNM
SETPS I PSSRTLOC Q
N %,PSSHASHP,X,%H,%I,PSSHASHZ,PSSHASHO
K PSSHASHP,PSSHASHZ,PSSHASHO S PSSHASHO=$S($P($G(^PS(51.2,PSSRTIEN,1)),"^"):$P($G(^PS(51.2,PSSRTIEN,1)),"^"),1:"")
S $P(^PS(51.2,PSSRTIEN,1),"^")=PSSRTSTS
D NOW^%DTC S PSSHASHP(51.27,"+1,"_PSSRTIEN_",",.01)=%
S PSSHASHP(51.27,"+1,"_PSSRTIEN_",",1)=""
S PSSHASHP(51.27,"+1,"_PSSRTIEN_",",2)=PSSHASHO
S PSSHASHP(51.27,"+1,"_PSSRTIEN_",",3)=PSSRTSTS
D UPDATE^DIE("","PSSHASHP",,"PSSHASHZ")
Q
;
;
SETNW(PSSMRPQX,PSSMRPQZ) ;
;Called from Replaced with term logic
N %,PSSMRPQA,X,%H,%I,PSSMRPQB
K PSSMRPQA,PSSMRPQB
S $P(^PS(51.2,PSSRTIEN,1),"^")=PSSMRPQZ
D NOW^%DTC S PSSMRPQA(51.27,"+1,"_PSSRTIEN_",",.01)=%
S PSSMRPQA(51.27,"+1,"_PSSRTIEN_",",1)=""
S PSSMRPQA(51.27,"+1,"_PSSRTIEN_",",2)=PSSMRPQX
S PSSMRPQA(51.27,"+1,"_PSSRTIEN_",",3)=PSSMRPQZ
D UPDATE^DIE("","PSSMRPQA",,"PSSMRPQB")
Q
;
;
INCT ;Check Inactivation global
N PSSMRPJ6,PSSMRPJ7,PSSMRPJ8,PSSMRPOL,PSSMRPNW
S PSSMRPJ6=$P($G(^PS(51.2,PSSRTIEN,1)),"^") Q:'PSSMRPJ6
I '$D(^TMP($J,"PSSMRPCC","INACT",PSSMRPJ6)) Q
;Assuming .01 cannot change, if it does, would need old name from 51.23, and need to set piece 2 of INACT global above
S PSSMRPOL=$P($G(^PS(51.23,+$G(PSSMRPJ6),0)),"^")
S PSSMRPJ7=$P($G(^TMP($J,"PSSMRPCC","INACT",PSSMRPJ6)),"^")
S PSSMRPJ8=$S('$G(PSSMRPJ7):"",'$D(^PS(51.23,+PSSMRPJ7,0)):"",1:+PSSMRPJ7)
I PSSMRPJ8,$$SCREEN^XTID(51.23,.01,PSSMRPJ8_",") S PSSMRPJ8=""
;Still assuming .01 can't change, if so, need new name from 51.23
S PSSMRPNW=$S(+$G(PSSMRPJ8):$P($G(^PS(51.23,+$G(PSSMRPJ8),0)),"^"),1:"")
I 'PSSRTLOC D SETNW(PSSMRPJ6,PSSMRPJ8)
S ^TMP($J,"PSSMRUN",$S(PSSRTLOC:"PSSLCK",1:"PSSUNLCK"),PSSRTIEN)=$S('PSSMRPJ8:0_"^"_$G(PSSMRPOL),1:1_"^"_$G(PSSMRPOL)_"^"_$G(PSSMRPNW))
Q
;
;
FINAL ;
;Sets Local mapped and remapped sections of the mail message
N PSSMRPP1,PSSMRPP2,PSSMRPP3,PSSMRPP4,PSSMRPP5
S PSSMRPP5=0
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="The following entries in the Medication Routes (#51.2) File have been",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="mapped/remapped to a Standard Medication Route (#51.23) File entry.",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" ",PSSMRPCT=PSSMRPCT+1
F PSSMRPP1=0:0 S PSSMRPP1=$O(^TMP($J,"PSSMRUN","PSSUNLCK",PSSMRPP1)) Q:'PSSMRPP1 D
.I '$P($G(^TMP($J,"PSSMRUN","PSSUNLCK",PSSMRPP1)),"^") Q
.S PSSMRPP5=1
.S PSSMRPP2=$G(^TMP($J,"PSSMRUN","PSSUNLCK",PSSMRPP1))
.S PSSMRPP3=$S($P(PSSMRPP2,"^",2)="":"(None)",1:$P(PSSMRPP2,"^",2))
.S PSSMRPP4=$S($P(PSSMRPP2,"^",3)="":"(None)",1:$P(PSSMRPP2,"^",3))
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" "_$P($G(^PS(51.2,PSSMRPP1,0)),"^") S PSSMRPCT=PSSMRPCT+1
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" Previous Standard Route: "_PSSMRPP3 S PSSMRPCT=PSSMRPCT+1
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" New Standard Route: "_PSSMRPP4 S PSSMRPCT=PSSMRPCT+1
I 'PSSMRPP5 S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" (None)" S PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" " S PSSMRPCT=PSSMRPCT+1
D ATTN^PSSMRTUX S PSSMRPP5=0
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="The following entries in the Medication Routes (#51.2) File have been",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="unmapped from a Standard Medication Route (#51.23) File entry.",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" ",PSSMRPCT=PSSMRPCT+1
S PSSMRPP1=0
F PSSMRPP1=0:0 S PSSMRPP1=$O(^TMP($J,"PSSMRUN","PSSUNLCK",PSSMRPP1)) Q:'PSSMRPP1 D
.I $P($G(^TMP($J,"PSSMRUN","PSSUNLCK",PSSMRPP1)),"^") Q
.S PSSMRPP5=1
.S PSSMRPP2=$G(^TMP($J,"PSSMRUN","PSSUNLCK",PSSMRPP1))
.S PSSMRPP3=$S($P(PSSMRPP2,"^",2)="":"(None)",1:$P(PSSMRPP2,"^",2))
.S PSSMRPP4=$P(PSSMRPP2,"^",3) I PSSMRPP4="" S PSSMRPP4="(None)"
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" "_$P($G(^PS(51.2,PSSMRPP1,0)),"^") S PSSMRPCT=PSSMRPCT+1
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" Previous Standard Route: "_PSSMRPP3 S PSSMRPCT=PSSMRPCT+1
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" New Standard Route: "_PSSMRPP4 S PSSMRPCT=PSSMRPCT+1
I 'PSSMRPP5 S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" (None)" S PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" " S PSSMRPCT=PSSMRPCT+1
;
;
;Set Locked entries sections of mail message
D ZERO^PSSMRTUX K PSSMRPP1,PSSMRPP2,PSSMRPP3,PSSMRPP4,PSSMRPP5
S PSSMRPP5=0
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="The following entries in the Medication Routes (#51.2) File were to be",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="mapped/remapped to a Standard Medication Route (#51.23) File entry, but",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="could not occur because the Medication Route (#51.2) File entry was locked.",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" ",PSSMRPCT=PSSMRPCT+1
F PSSMRPP1=0:0 S PSSMRPP1=$O(^TMP($J,"PSSMRUN","PSSLCK",PSSMRPP1)) Q:'PSSMRPP1 D
.I '$P($G(^TMP($J,"PSSMRUN","PSSLCK",PSSMRPP1)),"^") Q
.S PSSMRPP5=1
.S PSSMRPP2=$G(^TMP($J,"PSSMRUN","PSSLCK",PSSMRPP1))
.S PSSMRPP3=$S($P(PSSMRPP2,"^",2)="":"(None)",1:$P(PSSMRPP2,"^",2))
.S PSSMRPP4=$S($P(PSSMRPP2,"^",3)="":"(None)",1:$P(PSSMRPP2,"^",3))
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" "_$P($G(^PS(51.2,PSSMRPP1,0)),"^") S PSSMRPCT=PSSMRPCT+1
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" Current Standard Route: "_PSSMRPP3 S PSSMRPCT=PSSMRPCT+1
.D CHL^PSSMRTUX
I 'PSSMRPP5 S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" (None)" S PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" " S PSSMRPCT=PSSMRPCT+1
S PSSMRPP5=0
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="The following entries in the Medication Routes (#51.2) File were to be",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="unmapped from a Standard Medication Route (#51.23) File entry, but",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="could not occur because the Medication Route (#51.2) File entry was locked.",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" ",PSSMRPCT=PSSMRPCT+1
S PSSMRPP1=0
F PSSMRPP1=0:0 S PSSMRPP1=$O(^TMP($J,"PSSMRUN","PSSLCK",PSSMRPP1)) Q:'PSSMRPP1 D
.I $P($G(^TMP($J,"PSSMRUN","PSSLCK",PSSMRPP1)),"^") Q
.S PSSMRPP5=1
.S PSSMRPP2=$G(^TMP($J,"PSSMRUN","PSSLCK",PSSMRPP1))
.S PSSMRPP3=$S($P(PSSMRPP2,"^",2)="":"(None)",1:$P(PSSMRPP2,"^",2))
.S PSSMRPP4=$P(PSSMRPP2,"^",3) I PSSMRPP4="" S PSSMRPP4="<delete mapping>"
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" "_$P($G(^PS(51.2,PSSMRPP1,0)),"^") S PSSMRPCT=PSSMRPCT+1
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" Current Standard Route: "_PSSMRPP3 S PSSMRPCT=PSSMRPCT+1
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" New Standard Route: "_PSSMRPP4 S PSSMRPCT=PSSMRPCT+1
I 'PSSMRPP5 S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" (None)"
Q
;
;
OLDNM ;
I $P($G(^PS(51.2,PSSRTIEN,1)),"^") S $P(^TMP($J,"PSSMRUN",$S(PSSRTLOC:"PSSLCK",1:"PSSUNLCK"),PSSRTIEN),"^",2)=$P($G(^PS(51.23,+$P($G(^PS(51.2,PSSRTIEN,1)),"^"),0)),"^")
Q
PSSMRTUP ;BIR/RTR-Process Standard Medication Route File Updates ;03/02/09
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**147**;9/30/97;Build 16
+2 ;
+3 ;Reference to TMP("XUMF EVENT" supported by DBIA 5470
EN ;
+1 IF '$DATA(^TMP("XUMF EVENT",$JOB,51.23))
QUIT
+2 ;We are assuming the name of the .01 field will not change
+3 KILL ^TMP($JOB,"PSSMRPTX")
KILL ^TMP($JOB,"PSSMRPCC")
KILL ^TMP($JOB,"PSSMRUN")
+4 NEW PSSMRPCT
+5 SET PSSMRPCT=1
+6 DO NWRT
+7 DO STCH
+8 DO INACZ^PSSMRTUX
+9 DO LOCALS
+10 DO MAIL
KILL ^TMP($JOB,"PSSMRPCC")
KILL ^TMP($JOB,"PSSMRUN")
KILL ^TMP($JOB,"PSSMRPTX")
+11 QUIT
+12 ;
+13 ;
MAIL ;
+1 NEW XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMYBLOB,XMZ,XMDUN
+2 IF '$DATA(^TMP($JOB,"PSSMRPTX"))
QUIT
+3 SET XMSUB="Standard Medication Route File Update"
+4 SET XMDUZ="Standard Medication Route File Processor"
+5 SET XMTEXT="^TMP($J,""PSSMRPTX"","
+6 SET XMY("G.PSS ORDER CHECKS")=""
+7 NEW DIFROM
DO ^XMD
+8 ;K ^TMP($J,"PSSMRPTX")
+9 QUIT
+10 ;
+11 ;
STAT(PSSMRPEN) ;Return status of entry, assuming .01 and File 51.23
+1 IF $PIECE($$GETSTAT^XTID(51.23,.01,PSSMRPEN_","),"^")=1
QUIT 1
+2 QUIT 0
+3 ;
+4 ;
NWRT ;New Medication Routes
+1 NEW PSSMRPL,PSSMRPLN,PSSMRPL1,PSSMRPST
SET PSSMRPL1=0
+2 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="The following entries have been added to the Standard Medication Routes"
SET PSSMRPCT=PSSMRPCT+1
+3 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="(#51.23) File:"
SET PSSMRPCT=PSSMRPCT+1
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "
SET PSSMRPCT=PSSMRPCT+1
+4 FOR PSSMRPL=0:0
SET PSSMRPL=$ORDER(^TMP("XUMF EVENT",$JOB,51.23,"NEW",PSSMRPL))
IF 'PSSMRPL
QUIT
Begin DoDot:1
+5 SET PSSMRPLN=$GET(^PS(51.23,PSSMRPL,0))
IF PSSMRPLN=""
QUIT
+6 SET PSSMRPL1=1
SET PSSMRPST=$$STAT(PSSMRPL)
+7 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "_$PIECE(PSSMRPLN,"^")_$SELECT('PSSMRPST:" (Inactive)",1:"")
SET PSSMRPCT=PSSMRPCT+1
+8 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" FDB Route: "_$SELECT($PIECE(PSSMRPLN,"^",2)'="":$PIECE(PSSMRPLN,"^",2),1:"(None)")
SET PSSMRPCT=PSSMRPCT+1
End DoDot:1
+9 IF 'PSSMRPL1
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" (None)"
SET PSSMRPCT=PSSMRPCT+1
+10 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "
SET PSSMRPCT=PSSMRPCT+1
+11 QUIT
+12 ;
+13 ;
STCH ;Status changes
+1 ;Sets PSSMRPCC TMP global, which holds inactivated and reactivated entries
+2 ;If 0.1 changes, which it should not, we are just showing the 'after' value
+3 NEW PSSMRPBB,PSSMRPDD,PSSMRPEE,PSSMRPFF,PSSMRPGG,PSSMRPXX,PSSMRPZZ,PSSMRPLL,PSSMRPZA,PSSMRPZB
+4 SET PSSMRPFF=0
+5 FOR PSSMRPLL=0:0
SET PSSMRPLL=$ORDER(^TMP("XUMF EVENT",$JOB,51.23,"STATUS",PSSMRPLL))
IF 'PSSMRPLL
QUIT
Begin DoDot:1
+6 SET PSSMRPBB=$GET(^TMP("XUMF EVENT",$JOB,51.23,"STATUS",PSSMRPLL))
+7 IF PSSMRPBB=""
QUIT
+8 IF $PIECE(PSSMRPBB,"^",3)'=0
IF $PIECE(PSSMRPBB,"^",3)'=1
QUIT
+9 SET PSSMRPZA=$$RPLCMNT^XTIDTRM(51.23,PSSMRPLL)
SET PSSMRPZB=$PIECE(PSSMRPZA,";")
SET ^TMP($JOB,"PSSMRPCC",$SELECT($PIECE(PSSMRPBB,"^",3)=0:"INACT",1:"REACT"),PSSMRPLL)=$SELECT('PSSMRPZB:0,PSSMRPZB=PSSMRPLL:0,1:PSSMRPZB)
End DoDot:1
+10 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="The following entries have been inactivated in the Standard Medication"
SET PSSMRPCT=PSSMRPCT+1
+11 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="Routes (#51.23) File:"
SET PSSMRPCT=PSSMRPCT+1
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "
SET PSSMRPCT=PSSMRPCT+1
+12 KILL PSSMRPLL
+13 FOR PSSMRPLL=0:0
SET PSSMRPLL=$ORDER(^TMP($JOB,"PSSMRPCC","INACT",PSSMRPLL))
IF 'PSSMRPLL
QUIT
Begin DoDot:1
+14 SET PSSMRPXX=+PSSMRPLL_","
IF '$$SCREEN^XTID(51.23,.01,PSSMRPXX)
KILL ^TMP($JOB,"PSSMRPCC","INACT",PSSMRPLL)
QUIT
+15 SET PSSMRPFF=1
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "_$PIECE($GET(^PS(51.23,+PSSMRPLL,0)),"^")
SET PSSMRPCT=PSSMRPCT+1
+16 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" FDB Route: "_$SELECT($PIECE($GET(^PS(51.23,+PSSMRPLL,0)),"^",2)'="":$PIECE($GET(^PS(51.23,+PSSMRPLL,0)),"^",2),1:"(None)")
SET PSSMRPCT=PSSMRPCT+1
+17 SET PSSMRPDD=$GET(^TMP($JOB,"PSSMRPCC","INACT",PSSMRPLL))
+18 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" Replacement Term: "_$SELECT(+$GET(PSSMRPDD):$PIECE($GET(^PS(51.23,+PSSMRPDD,0)),"^"),1:"(None)")
SET PSSMRPCT=PSSMRPCT+1
+19 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" Replacement Term FDB Route: "_$SELECT('$GET(PSSMRPDD):"(None)",$PIECE($GET(^PS(51.23,+PSSMRPDD,0)),"^",2)'="":$PIECE($GET(^PS(51.23,+PSSMRPDD,0)),"^",2),1:"(None)")
SET PSSMRPCT=PSSMRPCT+1
End DoDot:1
+20 IF 'PSSMRPFF
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" (None)"
SET PSSMRPCT=PSSMRPCT+1
+21 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "
SET PSSMRPCT=PSSMRPCT+1
+22 SET PSSMRPGG=0
+23 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="The following entries have been reactivated in the Standard Medication"
SET PSSMRPCT=PSSMRPCT+1
+24 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="Routes (#51.23) File:"
SET PSSMRPCT=PSSMRPCT+1
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "
SET PSSMRPCT=PSSMRPCT+1
+25 FOR PSSMRPEE=0:0
SET PSSMRPEE=$ORDER(^TMP($JOB,"PSSMRPCC","REACT",PSSMRPEE))
IF 'PSSMRPEE
QUIT
Begin DoDot:1
+26 SET PSSMRPZZ=+PSSMRPEE_","
IF $$SCREEN^XTID(51.23,.01,PSSMRPZZ)
KILL ^TMP($JOB,"PSSMRPCC","REACT",PSSMRPEE)
QUIT
+27 SET PSSMRPGG=1
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "_$PIECE($GET(^PS(51.23,+PSSMRPEE,0)),"^")
SET PSSMRPCT=PSSMRPCT+1
+28 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" FDB Route: "_$SELECT($PIECE($GET(^PS(51.23,+PSSMRPEE,0)),"^",2)'="":$PIECE($GET(^PS(51.23,+PSSMRPEE,0)),"^",2),1:"(None)")
SET PSSMRPCT=PSSMRPCT+1
End DoDot:1
+29 IF 'PSSMRPGG
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" (None)"
SET PSSMRPCT=PSSMRPCT+1
+30 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "
SET PSSMRPCT=PSSMRPCT+1
+31 QUIT
+32 ;
+33 ;
LOCALS ;
+1 ;Loop through 51.2, call INCT to see if entry is in INACT Global, if so, then unmap local entry, then Remap if there is a replacement entry
+2 ;Then if local entry is still unmapped, execute standard Med Route mapping logic
+3 ;INCT and SET will set the PSSMRUN TMP global as follows, where piece 1 one = 1 for Mapped/Remapped, or = 0 for unmapped
+4 ;TMP($J,"PSSMRUN",Lock variable,51.2 IEN)=0 or 1^Old Mapped Name^New Mapped Name
+5 DO REMAP
+6 QUIT
+7 ;
+8 ;
REMAP ;Attempt to remap any unmapped local medication routes
+1 NEW PSSRTIEN,PSSRTNAM,PSSRTSTS,PSSRTIX,PSSRTLOC,PSSRTLOP,PSSRTLOX,PSSRTSHL
+2 SET PSSRTIX=""
FOR
SET PSSRTIX=$ORDER(^PS(51.2,"B",PSSRTIX))
IF PSSRTIX=""
QUIT
Begin DoDot:1
+3 FOR PSSRTIEN=0:0
SET PSSRTIEN=$ORDER(^PS(51.2,"B",PSSRTIX,PSSRTIEN))
IF 'PSSRTIEN
QUIT
Begin DoDot:2
+4 IF '$DATA(^PS(51.2,PSSRTIEN,0))
QUIT
+5 ;I '$P($G(^PS(51.2,PSSRTIEN,0)),"^",4) Q
+6 SET PSSRTLOC=0
LOCK +^PS(51.2,PSSRTIEN):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF '$TEST
SET PSSRTLOC=1
+7 ;Continue if record is locked, just do not set any data
+8 DO INCT
IF $PIECE($GET(^PS(51.2,PSSRTIEN,1)),"^")
IF '$DATA(^TMP($JOB,"PSSMRPCC","INACT",+$PIECE($GET(^PS(51.2,PSSRTIEN,1)),"^")))
DO UN
QUIT
+9 KILL PSSRTNAM,PSSRTSTS
IF '$PIECE($GET(^PS(51.2,PSSRTIEN,0)),"^",4)
DO UN
QUIT
+10 SET PSSRTNAM=$PIECE($GET(^PS(51.2,PSSRTIEN,0)),"^")
SET PSSRTNAM=$$UP^XLFSTR(PSSRTNAM)
+11 SET PSSRTSTS=$ORDER(^PS(51.23,"B",PSSRTNAM,0))
IF PSSRTSTS
IF '$$SCREEN^XTID(51.23,.01,PSSRTSTS_",")
DO SET
DO UN
QUIT
+12 KILL PSSRTSTS,PSSRTSHL
SET PSSRTLOX=0
FOR PSSRTLOP=0:0
SET PSSRTLOP=$ORDER(^PS(51.23,"C",PSSRTNAM,PSSRTLOP))
IF 'PSSRTLOP
QUIT
SET PSSRTSTS=PSSRTLOP
IF PSSRTSTS
IF '$$SCREEN^XTID(51.23,.01,PSSRTSTS_",")
SET PSSRTLOX=PSSRTLOX+1
SET PSSRTSHL=PSSRTSTS
+13 IF PSSRTLOX=1
SET PSSRTSTS=PSSRTSHL
DO SET
DO UN
QUIT
+14 KILL PSSRTSTS
IF PSSRTNAM[" EAR"
SET PSSRTSTS=$ORDER(^PS(51.23,"B","OTIC",0))
IF PSSRTSTS
IF '$$SCREEN^XTID(51.23,.01,PSSRTSTS_",")
DO SET
DO UN
QUIT
+15 KILL PSSRTSTS
IF PSSRTNAM[" EYE"
SET PSSRTSTS=$ORDER(^PS(51.23,"B","OPHTHALMIC",0))
IF PSSRTSTS
IF '$$SCREEN^XTID(51.23,.01,PSSRTSTS_",")
DO SET
DO UN
QUIT
+16 KILL PSSRTSTS
IF PSSRTNAM="G TUBE"!(PSSRTNAM="G-TUBE")!(PSSRTNAM="J TUBE")!(PSSRTNAM="J-TUBE")!(PSSRTNAM="NG TUBE")!(PSSRTNAM="NG-TUBE")
Begin DoDot:3
+17 SET PSSRTSTS=$ORDER(^PS(51.23,"B","ENTERAL",0))
End DoDot:3
IF PSSRTSTS
IF '$$SCREEN^XTID(51.23,.01,PSSRTSTS_",")
DO SET
DO UN
QUIT
+18 KILL PSSRTSTS
IF PSSRTNAM="BY MOUTH"
SET PSSRTSTS=$ORDER(^PS(51.23,"B","ORAL",0))
IF PSSRTSTS
IF '$$SCREEN^XTID(51.23,.01,PSSRTSTS_",")
DO SET
DO UN
QUIT
+19 KILL PSSRTSTS
IF PSSRTNAM["NOSE"!(PSSRTNAM["NASAL")!(PSSRTNAM["NOSTRIL")
SET PSSRTSTS=$ORDER(^PS(51.23,"B","NASAL",0))
IF PSSRTSTS
IF '$$SCREEN^XTID(51.23,.01,PSSRTSTS_",")
DO SET
DO UN
QUIT
+20 KILL PSSRTSTS
IF PSSRTNAM="IVPB"!(PSSRTNAM="IV PUSH")!(PSSRTNAM="IV PIGGYBACK")
SET PSSRTSTS=$ORDER(^PS(51.23,"B","INTRAVENOUS",0))
IF PSSRTSTS
IF '$$SCREEN^XTID(51.23,.01,PSSRTSTS_",")
DO SET
DO UN
QUIT
+21 DO UN
End DoDot:2
End DoDot:1
+22 DO FINAL
+23 QUIT
+24 ;
+25 ;
UN ;Unlock Med Route
+1 IF PSSRTLOC
QUIT
+2 LOCK -^PS(51.2,PSSRTIEN)
+3 QUIT
+4 ;
+5 ;
SET ;Set Data, leaving USER as null, so the installer is not recorded as the user
+1 IF '$DATA(^TMP($JOB,"PSSMRUN",$SELECT(PSSRTLOC:"PSSLCK",1:"PSSUNLCK"),PSSRTIEN))
SET ^TMP($JOB,"PSSMRUN",$SELECT(PSSRTLOC:"PSSLCK",1:"PSSUNLCK"),PSSRTIEN)=1_"^^"_$PIECE($GET(^PS(51.23,PSSRTSTS,0)),"^")
DO OLDNM
GOTO SETPS
+2 SET $PIECE(^TMP($JOB,"PSSMRUN",$SELECT(PSSRTLOC:"PSSLCK",1:"PSSUNLCK"),PSSRTIEN),"^",3)=$PIECE($GET(^PS(51.23,PSSRTSTS,0)),"^")
SET $PIECE(^TMP($JOB,"PSSMRUN",$SELECT(PSSRTLOC:"PSSLCK",1:"PSSUNLCK"),PSSRTIEN),"^")=1
DO OLDNM
SETPS IF PSSRTLOC
QUIT
+1 NEW %,PSSHASHP,X,%H,%I,PSSHASHZ,PSSHASHO
+2 KILL PSSHASHP,PSSHASHZ,PSSHASHO
SET PSSHASHO=$SELECT($PIECE($GET(^PS(51.2,PSSRTIEN,1)),"^"):$PIECE($GET(^PS(51.2,PSSRTIEN,1)),"^"),1:"")
+3 SET $PIECE(^PS(51.2,PSSRTIEN,1),"^")=PSSRTSTS
+4 DO NOW^%DTC
SET PSSHASHP(51.27,"+1,"_PSSRTIEN_",",.01)=%
+5 SET PSSHASHP(51.27,"+1,"_PSSRTIEN_",",1)=""
+6 SET PSSHASHP(51.27,"+1,"_PSSRTIEN_",",2)=PSSHASHO
+7 SET PSSHASHP(51.27,"+1,"_PSSRTIEN_",",3)=PSSRTSTS
+8 DO UPDATE^DIE("","PSSHASHP",,"PSSHASHZ")
+9 QUIT
+10 ;
+11 ;
SETNW(PSSMRPQX,PSSMRPQZ) ;
+1 ;Called from Replaced with term logic
+2 NEW %,PSSMRPQA,X,%H,%I,PSSMRPQB
+3 KILL PSSMRPQA,PSSMRPQB
+4 SET $PIECE(^PS(51.2,PSSRTIEN,1),"^")=PSSMRPQZ
+5 DO NOW^%DTC
SET PSSMRPQA(51.27,"+1,"_PSSRTIEN_",",.01)=%
+6 SET PSSMRPQA(51.27,"+1,"_PSSRTIEN_",",1)=""
+7 SET PSSMRPQA(51.27,"+1,"_PSSRTIEN_",",2)=PSSMRPQX
+8 SET PSSMRPQA(51.27,"+1,"_PSSRTIEN_",",3)=PSSMRPQZ
+9 DO UPDATE^DIE("","PSSMRPQA",,"PSSMRPQB")
+10 QUIT
+11 ;
+12 ;
INCT ;Check Inactivation global
+1 NEW PSSMRPJ6,PSSMRPJ7,PSSMRPJ8,PSSMRPOL,PSSMRPNW
+2 SET PSSMRPJ6=$PIECE($GET(^PS(51.2,PSSRTIEN,1)),"^")
IF 'PSSMRPJ6
QUIT
+3 IF '$DATA(^TMP($JOB,"PSSMRPCC","INACT",PSSMRPJ6))
QUIT
+4 ;Assuming .01 cannot change, if it does, would need old name from 51.23, and need to set piece 2 of INACT global above
+5 SET PSSMRPOL=$PIECE($GET(^PS(51.23,+$GET(PSSMRPJ6),0)),"^")
+6 SET PSSMRPJ7=$PIECE($GET(^TMP($JOB,"PSSMRPCC","INACT",PSSMRPJ6)),"^")
+7 SET PSSMRPJ8=$SELECT('$GET(PSSMRPJ7):"",'$DATA(^PS(51.23,+PSSMRPJ7,0)):"",1:+PSSMRPJ7)
+8 IF PSSMRPJ8
IF $$SCREEN^XTID(51.23,.01,PSSMRPJ8_",")
SET PSSMRPJ8=""
+9 ;Still assuming .01 can't change, if so, need new name from 51.23
+10 SET PSSMRPNW=$SELECT(+$GET(PSSMRPJ8):$PIECE($GET(^PS(51.23,+$GET(PSSMRPJ8),0)),"^"),1:"")
+11 IF 'PSSRTLOC
DO SETNW(PSSMRPJ6,PSSMRPJ8)
+12 SET ^TMP($JOB,"PSSMRUN",$SELECT(PSSRTLOC:"PSSLCK",1:"PSSUNLCK"),PSSRTIEN)=$SELECT('PSSMRPJ8:0_"^"_$GET(PSSMRPOL),1:1_"^"_$GET(PSSMRPOL)_"^"_$GET(PSSMRPNW))
+13 QUIT
+14 ;
+15 ;
FINAL ;
+1 ;Sets Local mapped and remapped sections of the mail message
+2 NEW PSSMRPP1,PSSMRPP2,PSSMRPP3,PSSMRPP4,PSSMRPP5
+3 SET PSSMRPP5=0
+4 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="The following entries in the Medication Routes (#51.2) File have been"
SET PSSMRPCT=PSSMRPCT+1
+5 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="mapped/remapped to a Standard Medication Route (#51.23) File entry."
SET PSSMRPCT=PSSMRPCT+1
+6 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "
SET PSSMRPCT=PSSMRPCT+1
+7 FOR PSSMRPP1=0:0
SET PSSMRPP1=$ORDER(^TMP($JOB,"PSSMRUN","PSSUNLCK",PSSMRPP1))
IF 'PSSMRPP1
QUIT
Begin DoDot:1
+8 IF '$PIECE($GET(^TMP($JOB,"PSSMRUN","PSSUNLCK",PSSMRPP1)),"^")
QUIT
+9 SET PSSMRPP5=1
+10 SET PSSMRPP2=$GET(^TMP($JOB,"PSSMRUN","PSSUNLCK",PSSMRPP1))
+11 SET PSSMRPP3=$SELECT($PIECE(PSSMRPP2,"^",2)="":"(None)",1:$PIECE(PSSMRPP2,"^",2))
+12 SET PSSMRPP4=$SELECT($PIECE(PSSMRPP2,"^",3)="":"(None)",1:$PIECE(PSSMRPP2,"^",3))
+13 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "_$PIECE($GET(^PS(51.2,PSSMRPP1,0)),"^")
SET PSSMRPCT=PSSMRPCT+1
+14 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" Previous Standard Route: "_PSSMRPP3
SET PSSMRPCT=PSSMRPCT+1
+15 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" New Standard Route: "_PSSMRPP4
SET PSSMRPCT=PSSMRPCT+1
End DoDot:1
+16 IF 'PSSMRPP5
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" (None)"
SET PSSMRPCT=PSSMRPCT+1
+17 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "
SET PSSMRPCT=PSSMRPCT+1
+18 DO ATTN^PSSMRTUX
SET PSSMRPP5=0
+19 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="The following entries in the Medication Routes (#51.2) File have been"
SET PSSMRPCT=PSSMRPCT+1
+20 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="unmapped from a Standard Medication Route (#51.23) File entry."
SET PSSMRPCT=PSSMRPCT+1
+21 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "
SET PSSMRPCT=PSSMRPCT+1
+22 SET PSSMRPP1=0
+23 FOR PSSMRPP1=0:0
SET PSSMRPP1=$ORDER(^TMP($JOB,"PSSMRUN","PSSUNLCK",PSSMRPP1))
IF 'PSSMRPP1
QUIT
Begin DoDot:1
+24 IF $PIECE($GET(^TMP($JOB,"PSSMRUN","PSSUNLCK",PSSMRPP1)),"^")
QUIT
+25 SET PSSMRPP5=1
+26 SET PSSMRPP2=$GET(^TMP($JOB,"PSSMRUN","PSSUNLCK",PSSMRPP1))
+27 SET PSSMRPP3=$SELECT($PIECE(PSSMRPP2,"^",2)="":"(None)",1:$PIECE(PSSMRPP2,"^",2))
+28 SET PSSMRPP4=$PIECE(PSSMRPP2,"^",3)
IF PSSMRPP4=""
SET PSSMRPP4="(None)"
+29 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "_$PIECE($GET(^PS(51.2,PSSMRPP1,0)),"^")
SET PSSMRPCT=PSSMRPCT+1
+30 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" Previous Standard Route: "_PSSMRPP3
SET PSSMRPCT=PSSMRPCT+1
+31 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" New Standard Route: "_PSSMRPP4
SET PSSMRPCT=PSSMRPCT+1
End DoDot:1
+32 IF 'PSSMRPP5
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" (None)"
SET PSSMRPCT=PSSMRPCT+1
+33 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "
SET PSSMRPCT=PSSMRPCT+1
+34 ;
+35 ;
+36 ;Set Locked entries sections of mail message
+37 DO ZERO^PSSMRTUX
KILL PSSMRPP1,PSSMRPP2,PSSMRPP3,PSSMRPP4,PSSMRPP5
+38 SET PSSMRPP5=0
+39 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="The following entries in the Medication Routes (#51.2) File were to be"
SET PSSMRPCT=PSSMRPCT+1
+40 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="mapped/remapped to a Standard Medication Route (#51.23) File entry, but"
SET PSSMRPCT=PSSMRPCT+1
+41 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="could not occur because the Medication Route (#51.2) File entry was locked."
SET PSSMRPCT=PSSMRPCT+1
+42 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "
SET PSSMRPCT=PSSMRPCT+1
+43 FOR PSSMRPP1=0:0
SET PSSMRPP1=$ORDER(^TMP($JOB,"PSSMRUN","PSSLCK",PSSMRPP1))
IF 'PSSMRPP1
QUIT
Begin DoDot:1
+44 IF '$PIECE($GET(^TMP($JOB,"PSSMRUN","PSSLCK",PSSMRPP1)),"^")
QUIT
+45 SET PSSMRPP5=1
+46 SET PSSMRPP2=$GET(^TMP($JOB,"PSSMRUN","PSSLCK",PSSMRPP1))
+47 SET PSSMRPP3=$SELECT($PIECE(PSSMRPP2,"^",2)="":"(None)",1:$PIECE(PSSMRPP2,"^",2))
+48 SET PSSMRPP4=$SELECT($PIECE(PSSMRPP2,"^",3)="":"(None)",1:$PIECE(PSSMRPP2,"^",3))
+49 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "_$PIECE($GET(^PS(51.2,PSSMRPP1,0)),"^")
SET PSSMRPCT=PSSMRPCT+1
+50 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" Current Standard Route: "_PSSMRPP3
SET PSSMRPCT=PSSMRPCT+1
+51 DO CHL^PSSMRTUX
End DoDot:1
+52 IF 'PSSMRPP5
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" (None)"
SET PSSMRPCT=PSSMRPCT+1
+53 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "
SET PSSMRPCT=PSSMRPCT+1
+54 SET PSSMRPP5=0
+55 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="The following entries in the Medication Routes (#51.2) File were to be"
SET PSSMRPCT=PSSMRPCT+1
+56 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="unmapped from a Standard Medication Route (#51.23) File entry, but"
SET PSSMRPCT=PSSMRPCT+1
+57 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="could not occur because the Medication Route (#51.2) File entry was locked."
SET PSSMRPCT=PSSMRPCT+1
+58 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "
SET PSSMRPCT=PSSMRPCT+1
+59 SET PSSMRPP1=0
+60 FOR PSSMRPP1=0:0
SET PSSMRPP1=$ORDER(^TMP($JOB,"PSSMRUN","PSSLCK",PSSMRPP1))
IF 'PSSMRPP1
QUIT
Begin DoDot:1
+61 IF $PIECE($GET(^TMP($JOB,"PSSMRUN","PSSLCK",PSSMRPP1)),"^")
QUIT
+62 SET PSSMRPP5=1
+63 SET PSSMRPP2=$GET(^TMP($JOB,"PSSMRUN","PSSLCK",PSSMRPP1))
+64 SET PSSMRPP3=$SELECT($PIECE(PSSMRPP2,"^",2)="":"(None)",1:$PIECE(PSSMRPP2,"^",2))
+65 SET PSSMRPP4=$PIECE(PSSMRPP2,"^",3)
IF PSSMRPP4=""
SET PSSMRPP4="<delete mapping>"
+66 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "_$PIECE($GET(^PS(51.2,PSSMRPP1,0)),"^")
SET PSSMRPCT=PSSMRPCT+1
+67 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" Current Standard Route: "_PSSMRPP3
SET PSSMRPCT=PSSMRPCT+1
+68 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" New Standard Route: "_PSSMRPP4
SET PSSMRPCT=PSSMRPCT+1
End DoDot:1
+69 IF 'PSSMRPP5
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" (None)"
+70 QUIT
+71 ;
+72 ;
OLDNM ;
+1 IF $PIECE($GET(^PS(51.2,PSSRTIEN,1)),"^")
SET $PIECE(^TMP($JOB,"PSSMRUN",$SELECT(PSSRTLOC:"PSSLCK",1:"PSSUNLCK"),PSSRTIEN),"^",2)=$PIECE($GET(^PS(51.23,+$PIECE($GET(^PS(51.2,PSSRTIEN,1)),"^"),0)),"^")
+2 QUIT
