- 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
- 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
