PSSMRTUX ;BIR/RTR-Process Standard Medication Route File Updates continued ;03/02/09
;;1.0;PHARMACY DATA MANAGEMENT;**147**;9/30/97;Build 16
;
;Reference to TMP("XUMF EVENT" supported by DBIA 5470
CHL ;Check Length, called from locked entries section of PSSMRTUP
N PSSMRTL1
S PSSMRTL1=$L(PSSMRPP4)
I PSSMRTL1<37 S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" Recommend mapping to Standard Route: "_PSSMRPP4 S PSSMRPCT=PSSMRPCT+1 Q
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" Recommend mapping to Standard Route:" S PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" "_PSSMRPP4 S PSSMRPCT=PSSMRPCT+1
Q
;
;
ATTN ;
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="PLEASE REVIEW, MAY REQUIRE YOUR ATTENTION!",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" ",PSSMRPCT=PSSMRPCT+1
Q
;
;
ZERO ;Miscellaneous Standard Med Route changes
N PSSMRPHH,PSSMRPJ1,PSSMRPJ2,PSSMRPJ5,PSSMRPA1,PSSMRPA2,PSSMRPA3,PSSMRPA4,PSSMRPA5,PSSMRPA6,PSSMRPA8,PSSMRPA9,PSSMRPA7
;If just the .01 changes, we are not showing
S PSSMRPJ5=0
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="The following entries in the Standard Medication Routes (#51.23) File have had",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)="changes to the associated First DataBank Med Route and/or Replacement Term.",PSSMRPCT=PSSMRPCT+1 S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" ",PSSMRPCT=PSSMRPCT+1
S PSSMRPCT=PSSMRPCT+1
F PSSMRPHH=0:0 S PSSMRPHH=$O(^TMP("XUMF EVENT",$J,51.23,"BEFORE",PSSMRPHH)) Q:'PSSMRPHH D
.S PSSMRPJ1=$P($G(^TMP("XUMF EVENT",$J,51.23,"BEFORE",PSSMRPHH,0)),"^",2)
.S PSSMRPJ2=$P($G(^TMP("XUMF EVENT",$J,51.23,"AFTER",PSSMRPHH,0)),"^",2)
.S PSSMRPA1=$P($G(^TMP("XUMF EVENT",$J,51.23,"BEFORE",PSSMRPHH,"VUID")),"^",3)
.S PSSMRPA2=$P($G(^TMP("XUMF EVENT",$J,51.23,"AFTER",PSSMRPHH,"VUID")),"^",3)
.S (PSSMRPA3,PSSMRPA4)=0 K PSSMRPA5,PSSMRPA6,PSSMRPA7
.I PSSMRPJ1'=PSSMRPJ2 S PSSMRPA3=1
.I PSSMRPA1'=PSSMRPA2 S PSSMRPA4=1
.I 'PSSMRPA3,'PSSMRPA4 Q
.I PSSMRPA3 S PSSMRPA5=$S($G(PSSMRPJ2)'="":$G(PSSMRPJ2),1:"<deleted>")
.I PSSMRPA4 S PSSMRPA6=$S('$G(PSSMRPA2):"<deleted>",1:$P($G(^PS(51.23,+$G(PSSMRPA2),0)),"^")) S PSSMRPA7=$S('$G(PSSMRPA2):"<deleted>",$P($G(^PS(51.23,+$G(PSSMRPA2),0)),"^",2)'="":$P($G(^PS(51.23,+$G(PSSMRPA2),0)),"^",2),1:"(None)")
.S PSSMRPJ5=1 S PSSMRPA8=PSSMRPHH S PSSMRPA9=$$STAT^PSSMRTUP(PSSMRPA8)
.S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" "_$P($G(^PS(51.23,+PSSMRPHH,0)),"^")_$S('PSSMRPA9:" (Inactive)",1:"") S PSSMRPCT=PSSMRPCT+1
.I PSSMRPA3 S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" FDB Route: "_$G(PSSMRPA5) S PSSMRPCT=PSSMRPCT+1
.I PSSMRPA4 S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" Replacement Term: "_$G(PSSMRPA6) S PSSMRPCT=PSSMRPCT+1 I $G(PSSMRPA2) S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" Replacement Term FDB Route: "_$G(PSSMRPA7) S PSSMRPCT=PSSMRPCT+1
I 'PSSMRPJ5 S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" (None)",PSSMRPCT=PSSMRPCT+1
S ^TMP($J,"PSSMRPTX",PSSMRPCT,0)=" " S PSSMRPCT=PSSMRPCT+1
Q
;
;
INACZ ;Set 51.23 entries as Inactive if the FDB Route has changed
;
;Here we only reset the value of Inact if the FDB field changes
N PSSMRPWH,PSSMRPWJ,PSSMRPW1,PSSMRPW2,PSSMRPW9,PSSMRPW8,PSSMRPW7
F PSSMRPWH=0:0 S PSSMRPWH=$O(^TMP("XUMF EVENT",$J,51.23,"BEFORE",PSSMRPWH)) Q:'PSSMRPWH D
.S PSSMRPWJ=$G(^TMP("XUMF EVENT",$J,51.23,"BEFORE",PSSMRPWH,0)) Q:PSSMRPWJ=""
.S PSSMRPW1=$P($G(^TMP("XUMF EVENT",$J,51.23,"BEFORE",PSSMRPWH,0)),"^",2)
.S PSSMRPW2=$P($G(^TMP("XUMF EVENT",$J,51.23,"AFTER",PSSMRPWH,0)),"^",2)
.I PSSMRPW1=PSSMRPW2 Q
.S PSSMRPW7=""
.S PSSMRPW8=PSSMRPWH
.S PSSMRPW9=$$RPLCMNT^XTIDTRM(51.23,PSSMRPW8)
.I $P(PSSMRPW9,";")'=PSSMRPWH S PSSMRPW7=$P(PSSMRPW9,";")
.I '$D(^TMP($J,"PSSMRPCC","INACT",PSSMRPWH)) D Q
..;S ^TMP($J,"PSSMRPCC","INACT",PSSMRPWH)=$S('$P($G(^TMP("XUMF EVENT",$J,51.23,"AFTER",PSSMRPWH,"REPLACED BY")),"^"):0,1:$P($G(^TMP("XUMF EVENT",$J,51.23,"AFTER",PSSMRPWH,"REPLACED BY")),"^"))
..S ^TMP($J,"PSSMRPCC","INACT",PSSMRPWH)=$S('$G(PSSMRPW7):0,1:$G(PSSMRPW7))
.I '^TMP($J,"PSSMRPCC","INACT",PSSMRPWH),$G(PSSMRPW7) S ^TMP($J,"PSSMRPCC","INACT",PSSMRPWH)=$G(PSSMRPW7)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSMRTUX 4080 printed Oct 16, 2024@18:33:52 Page 2
PSSMRTUX ;BIR/RTR-Process Standard Medication Route File Updates continued ;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
CHL ;Check Length, called from locked entries section of PSSMRTUP
+1 NEW PSSMRTL1
+2 SET PSSMRTL1=$LENGTH(PSSMRPP4)
+3 IF PSSMRTL1<37
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" Recommend mapping to Standard Route: "_PSSMRPP4
SET PSSMRPCT=PSSMRPCT+1
QUIT
+4 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" Recommend mapping to Standard Route:"
SET PSSMRPCT=PSSMRPCT+1
+5 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "_PSSMRPP4
SET PSSMRPCT=PSSMRPCT+1
+6 QUIT
+7 ;
+8 ;
ATTN ;
+1 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="PLEASE REVIEW, MAY REQUIRE YOUR ATTENTION!"
SET PSSMRPCT=PSSMRPCT+1
+2 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "
SET PSSMRPCT=PSSMRPCT+1
+3 QUIT
+4 ;
+5 ;
ZERO ;Miscellaneous Standard Med Route changes
+1 NEW PSSMRPHH,PSSMRPJ1,PSSMRPJ2,PSSMRPJ5,PSSMRPA1,PSSMRPA2,PSSMRPA3,PSSMRPA4,PSSMRPA5,PSSMRPA6,PSSMRPA8,PSSMRPA9,PSSMRPA7
+2 ;If just the .01 changes, we are not showing
+3 SET PSSMRPJ5=0
+4 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="The following entries in the Standard Medication Routes (#51.23) File have had"
SET PSSMRPCT=PSSMRPCT+1
+5 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)="changes to the associated First DataBank Med Route and/or Replacement Term."
SET PSSMRPCT=PSSMRPCT+1
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "
SET PSSMRPCT=PSSMRPCT+1
+6 SET PSSMRPCT=PSSMRPCT+1
+7 FOR PSSMRPHH=0:0
SET PSSMRPHH=$ORDER(^TMP("XUMF EVENT",$JOB,51.23,"BEFORE",PSSMRPHH))
if 'PSSMRPHH
QUIT
Begin DoDot:1
+8 SET PSSMRPJ1=$PIECE($GET(^TMP("XUMF EVENT",$JOB,51.23,"BEFORE",PSSMRPHH,0)),"^",2)
+9 SET PSSMRPJ2=$PIECE($GET(^TMP("XUMF EVENT",$JOB,51.23,"AFTER",PSSMRPHH,0)),"^",2)
+10 SET PSSMRPA1=$PIECE($GET(^TMP("XUMF EVENT",$JOB,51.23,"BEFORE",PSSMRPHH,"VUID")),"^",3)
+11 SET PSSMRPA2=$PIECE($GET(^TMP("XUMF EVENT",$JOB,51.23,"AFTER",PSSMRPHH,"VUID")),"^",3)
+12 SET (PSSMRPA3,PSSMRPA4)=0
KILL PSSMRPA5,PSSMRPA6,PSSMRPA7
+13 IF PSSMRPJ1'=PSSMRPJ2
SET PSSMRPA3=1
+14 IF PSSMRPA1'=PSSMRPA2
SET PSSMRPA4=1
+15 IF 'PSSMRPA3
IF 'PSSMRPA4
QUIT
+16 IF PSSMRPA3
SET PSSMRPA5=$SELECT($GET(PSSMRPJ2)'="":$GET(PSSMRPJ2),1:"<deleted>")
+17 IF PSSMRPA4
SET PSSMRPA6=$SELECT('$GET(PSSMRPA2):"<deleted>",1:$PIECE($GET(^PS(51.23,+$GET(PSSMRPA2),0)),"^"))
SET PSSMRPA7=$SELECT('$GET(PSSMRPA2):"<deleted>",$PIECE($GET(^PS(51.23,+$GET(PSSMRPA2),0)),"^",2)'="":$PIECE($GET(^PS(51.23,+$GET(PSSMRPA2),0)),"^",2),1:"(None)")
+18 SET PSSMRPJ5=1
SET PSSMRPA8=PSSMRPHH
SET PSSMRPA9=$$STAT^PSSMRTUP(PSSMRPA8)
+19 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "_$PIECE($GET(^PS(51.23,+PSSMRPHH,0)),"^")_$SELECT('PSSMRPA9:" (Inactive)",1:"")
SET PSSMRPCT=PSSMRPCT+1
+20 IF PSSMRPA3
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" FDB Route: "_$GET(PSSMRPA5)
SET PSSMRPCT=PSSMRPCT+1
+21 IF PSSMRPA4
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" Replacement Term: "_$GET(PSSMRPA6)
SET PSSMRPCT=PSSMRPCT+1
IF $GET(PSSMRPA2)
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" Replacement Term FDB Route: "_$GET(PSSMRPA7)
SET PSSMRPCT=PSSMRPCT+1
End DoDot:1
+22 IF 'PSSMRPJ5
SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" (None)"
SET PSSMRPCT=PSSMRPCT+1
+23 SET ^TMP($JOB,"PSSMRPTX",PSSMRPCT,0)=" "
SET PSSMRPCT=PSSMRPCT+1
+24 QUIT
+25 ;
+26 ;
INACZ ;Set 51.23 entries as Inactive if the FDB Route has changed
+1 ;
+2 ;Here we only reset the value of Inact if the FDB field changes
+3 NEW PSSMRPWH,PSSMRPWJ,PSSMRPW1,PSSMRPW2,PSSMRPW9,PSSMRPW8,PSSMRPW7
+4 FOR PSSMRPWH=0:0
SET PSSMRPWH=$ORDER(^TMP("XUMF EVENT",$JOB,51.23,"BEFORE",PSSMRPWH))
if 'PSSMRPWH
QUIT
Begin DoDot:1
+5 SET PSSMRPWJ=$GET(^TMP("XUMF EVENT",$JOB,51.23,"BEFORE",PSSMRPWH,0))
if PSSMRPWJ=""
QUIT
+6 SET PSSMRPW1=$PIECE($GET(^TMP("XUMF EVENT",$JOB,51.23,"BEFORE",PSSMRPWH,0)),"^",2)
+7 SET PSSMRPW2=$PIECE($GET(^TMP("XUMF EVENT",$JOB,51.23,"AFTER",PSSMRPWH,0)),"^",2)
+8 IF PSSMRPW1=PSSMRPW2
QUIT
+9 SET PSSMRPW7=""
+10 SET PSSMRPW8=PSSMRPWH
+11 SET PSSMRPW9=$$RPLCMNT^XTIDTRM(51.23,PSSMRPW8)
+12 IF $PIECE(PSSMRPW9,";")'=PSSMRPWH
SET PSSMRPW7=$PIECE(PSSMRPW9,";")
+13 IF '$DATA(^TMP($JOB,"PSSMRPCC","INACT",PSSMRPWH))
Begin DoDot:2
+14 ;S ^TMP($J,"PSSMRPCC","INACT",PSSMRPWH)=$S('$P($G(^TMP("XUMF EVENT",$J,51.23,"AFTER",PSSMRPWH,"REPLACED BY")),"^"):0,1:$P($G(^TMP("XUMF EVENT",$J,51.23,"AFTER",PSSMRPWH,"REPLACED BY")),"^"))
+15 SET ^TMP($JOB,"PSSMRPCC","INACT",PSSMRPWH)=$SELECT('$GET(PSSMRPW7):0,1:$GET(PSSMRPW7))
End DoDot:2
QUIT
+16 IF '^TMP($JOB,"PSSMRPCC","INACT",PSSMRPWH)
IF $GET(PSSMRPW7)
SET ^TMP($JOB,"PSSMRPCC","INACT",PSSMRPWH)=$GET(PSSMRPW7)
End DoDot:1
+17 QUIT
