ORDV06C ;ISP/RFR - OE/RR REPORT EXTRACTS ;08/22/2017 13:39
;;3.0;ORDER ENTRY RESULTS REPORTING;**377**;Dec 17, 1997;Build 582
Q
RXHIRISK(ROOT,ORDFN,OREXT,ORALPHA,OROMEGA,ORDTRANG,ORREMOTE,ORMAX,ISFHIE) ;Medications with
;Reproductive Risk Report
Q:'$L(OREXT)
N GO
S GO=$P(OREXT,";",7)_U_$P(OREXT,";",8)
Q:'$L($T(@GO))
D FORMAT
Q
GETDATA ;RETRIEVE ALL NECESSARY DATA FOR REPORT
N ORBEG,OREND,ORREMIND,INDEX,PARAM,RETURN,OCINAME,ORIEN,NODE
K ^TMP("ORPS",$J)
S ORBEG=$S($G(ORALPHA):ORALPHA,1:$$DT^ORWPS("T")),OREND=$S($G(OROMEGA)>0:OROMEGA,1:$$DT^ORWPS("T"))
S ORREMIND="VA-WH POTENTIALLY UNSAFE MEDICATIONS REPORT - COHORT",ORREMIND("PRINT")="WH POTENTIALLY UNSAFE MEDS REPORT"
D MAINDF^PXRM(DFN,ORREMIND,0,ORBEG)
S ORREMIND("IEN")=+$O(^TMP("PXRHM",$J,0))
I $P($G(^TMP("PXRHM",$J,ORREMIND("IEN"),ORREMIND("PRINT"))),U)'="DUE NOW" G GEXIT
S PARAM("SUB")="ORWHRMR",PARAM("DFN")=DFN
S PARAM("ROC DISPLAY GROUPS","PHARMACY")="",NODE="GROUPS"
I '(($P(ORBEG,".")=$P(OREND,"."))&($P(ORBEG,".")=$$DT^ORWPS("T"))) D
.S PARAM("ROC","VA-WH HIRISK IMAGING AGENTS GROUP")="",PARAM("ROC","VA-WH HIRISK MEDICATIONS (EXTREME RISK) GROUP")=""
.S PARAM("ROC","VA-WH HIRISK MEDICATIONS (LACTATION LEVEL 1) GROUP")="",PARAM("ROC","VA-WH HIRISK MEDICATIONS (LACTATION LEVEL 2) GROUP")=""
.S PARAM("ROC","VA-WH HIRISK MEDICATIONS (MOD/HIGH RISK DURING PREGNANCY) GROUP")=""
.S PARAM("ROC RETURN TYPE","GROUPS")="",PARAM("ROC ORDERED WITHIN")=""
.S PARAM("ROC STATUS","*")=""
.S PARAM("ROC DISPLAY GROUPS","PHARMACY","START")=ORBEG,PARAM("ROC DISPLAY GROUPS","PHARMACY","STOP")=OREND
I $P(ORBEG,".")=$P(OREND,"."),$P(ORBEG,".")=$$DT^ORWPS("T") D
.S PARAM("ROC","ALL")="" ;,PARAM("ROC EVAL DATES")=DT
.S PARAM("ROC STATUS","HOLD")="",PARAM("ROC STATUS","FLAGGED")="",PARAM("ROC STATUS","PENDING")=""
.S PARAM("ROC STATUS","ACTIVE")="",PARAM("ROC STATUS","DELAYED")="",PARAM("ROC STATUS","RENEWED")=""
.S PARAM("ROC RETURN TYPE","GROUPS")="",PARAM("ROC RETURN TYPE","RULES")=""
D EN^PXRMGEV(.RETURN,.PARAM)
I $P(@RETURN@(0),U)<1 G GEXIT
S ORIEN=0 F S ORIEN=$O(^TMP($J,"ORWHRMR",ORIEN)) Q:'+ORIEN D
.N PSIFN
.S PSIFN=$G(^OR(100,ORIEN,4)) Q:'+PSIFN
.S INDEX=1+$G(INDEX),OCINAME=""
.F S OCINAME=$O(^TMP($J,"ORWHRMR",ORIEN,NODE,OCINAME)) Q:OCINAME="" I $E(OCINAME,1,13)="VA-WH HIRISK " D
..I $D(PARAM("ROC RETURN TYPE","RULES")),'$D(^TMP($J,"ORWHRMR",ORIEN,"RULES")) Q
..I '$D(^TMP("ORPS",$J,INDEX)) D
...N TYPE,NODE,TO
...S TYPE=$P($G(^OR(100,ORIEN,0)),U,12),TO=$P($G(^ORD(100.98,+$P($G(^OR(100,ORIEN,0)),U,11),0)),U)
...I TYPE="O",TO["CLINIC" S TYPE="I"
...S:TYPE="O" PSIFN=$TR(PSIFN,"S","P")_$S(PSIFN?1.N:"R",1:"")
...S PSIFN=PSIFN_";"_TYPE
...D OEL^PSOORRL(DFN,PSIFN) ;DBIA 2400
...I '$D(^TMP("PS",$J)) Q
...S TYPE=$S(TYPE="O":"OP",1:"UD")
...I TYPE="OP",PSIFN["N" S TYPE="NV"
...I ($O(^TMP("PS",$J,"A",0))>0)!($O(^TMP("PS",$J,"B",0))>0) S TYPE="IV"
...S NODE=$G(^TMP("PS",$J,0))
...S ^TMP("ORPS",$J,INDEX)=TYPE_U_PSIFN_U_$P(NODE,U)_U_$P(NODE,U,3)_U_$P(NODE,U,5,6)_U_$P(NODE,U,12)
...S:TYPE="NV" $P(^TMP("ORPS",$J,INDEX),U,5)=$P($G(^OR(100,ORIEN,0)),U,8)
...I $P(^TMP("ORPS",$J,INDEX),U,6)="PENDING" S $P(^(INDEX),U,5)=""
..Q:'$D(^TMP("ORPS",$J,INDEX))
..I OCINAME'["(LACT" S $P(^TMP("ORPS",$J,INDEX),U,8)="*"
..I OCINAME["(LACT" S $P(^TMP("ORPS",$J,INDEX),U,9)="*"
GEXIT ;CLEAN-UP FOR GETDATA
K ^TMP("PXRHM",$J),^TMP("PS",$J),^TMP($J,"ORWHRMR")
Q
FORMAT ;FORMAT DATA FOR RETURN TO CPRS
K ^TMP("ORPS",$J)
D @GO
N ORSITE,J,RT,X,ORITM
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
S ORITM=0 F S ORITM=$O(^TMP("ORPS",$J,ORITM)) Q:'+ORITM D
.S ^TMP("ORDATA",$J,ORITM,"WP",1)="1^"_ORSITE ;Station ID
.S ^TMP("ORDATA",$J,ORITM,"WP",2)="2^"_$P(^TMP("ORPS",$J,ORITM),U,3) ;Medication Name
.S ^TMP("ORDATA",$J,ORITM,"WP",3)="3^"_$P(^TMP("ORPS",$J,ORITM),U,6) ;Status
.S ^TMP("ORDATA",$J,ORITM,"WP",4)="4^"_$S($P($P(^TMP("ORPS",$J,ORITM),U,2),";",2)="I":"IN",1:"OUT") ;In/OutPatient
.S ^TMP("ORDATA",$J,ORITM,"WP",5)="5^"_$S($P(^TMP("ORPS",$J,ORITM),U)="NV":"NonVAMed",1:"RX") ;Type: RX or NonVA Med
.S ^TMP("ORDATA",$J,ORITM,"WP",6)="6^"_$P(^TMP("ORPS",$J,ORITM),U,8) ;Teratogenic
.S ^TMP("ORDATA",$J,ORITM,"WP",7)="7^"_$P(^TMP("ORPS",$J,ORITM),U,9) ;Lactation
.S ^TMP("ORDATA",$J,ORITM,"WP",8)="8^"_$$DATE^ORDVU($P(^TMP("ORPS",$J,ORITM),U,5)) ;Start Date
.S ^TMP("ORDATA",$J,ORITM,"WP",9)="9^"_$$DATE^ORDVU($P(^TMP("ORPS",$J,ORITM),U,4)) ;Stop Date
.S ^TMP("ORDATA",$J,ORITM,"WP",10)="10^"_$$DATE^ORDVU($P(^TMP("ORPS",$J,ORITM),U,7)) ;Last Fill Date
.D DETAIL^ORWPS(.RT,DFN,$P(^TMP("ORPS",$J,ORITM),U,2))
.S J=0 F S J=$O(^TMP("ORXPND",$J,J)) Q:'J S X=^(J,0),^TMP("ORDATA",$J,ORITM,"WP",11,J)="11^"_X ;Details from Order
.K ^TMP("ORXPND",$J)
.S ^TMP("ORDATA",$J,ORITM,"WP",12)="12^[+] " ;flag for detail
K ^TMP("ORPS",$J)
S ROOT=$NA(^TMP("ORDATA",$J))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDV06C 4915 printed Apr 09, 2024@21:43:40 Page 2
ORDV06C ;ISP/RFR - OE/RR REPORT EXTRACTS ;08/22/2017 13:39
+1 ;;3.0;ORDER ENTRY RESULTS REPORTING;**377**;Dec 17, 1997;Build 582
+2 QUIT
RXHIRISK(ROOT,ORDFN,OREXT,ORALPHA,OROMEGA,ORDTRANG,ORREMOTE,ORMAX,ISFHIE) ;Medications with
+1 ;Reproductive Risk Report
+2 if '$LENGTH(OREXT)
QUIT
+3 NEW GO
+4 SET GO=$PIECE(OREXT,";",7)_U_$PIECE(OREXT,";",8)
+5 if '$LENGTH($TEXT(@GO))
QUIT
+6 DO FORMAT
+7 QUIT
GETDATA ;RETRIEVE ALL NECESSARY DATA FOR REPORT
+1 NEW ORBEG,OREND,ORREMIND,INDEX,PARAM,RETURN,OCINAME,ORIEN,NODE
+2 KILL ^TMP("ORPS",$JOB)
+3 SET ORBEG=$SELECT($GET(ORALPHA):ORALPHA,1:$$DT^ORWPS("T"))
SET OREND=$SELECT($GET(OROMEGA)>0:OROMEGA,1:$$DT^ORWPS("T"))
+4 SET ORREMIND="VA-WH POTENTIALLY UNSAFE MEDICATIONS REPORT - COHORT"
SET ORREMIND("PRINT")="WH POTENTIALLY UNSAFE MEDS REPORT"
+5 DO MAINDF^PXRM(DFN,ORREMIND,0,ORBEG)
+6 SET ORREMIND("IEN")=+$ORDER(^TMP("PXRHM",$JOB,0))
+7 IF $PIECE($GET(^TMP("PXRHM",$JOB,ORREMIND("IEN"),ORREMIND("PRINT"))),U)'="DUE NOW"
GOTO GEXIT
+8 SET PARAM("SUB")="ORWHRMR"
SET PARAM("DFN")=DFN
+9 SET PARAM("ROC DISPLAY GROUPS","PHARMACY")=""
SET NODE="GROUPS"
+10 IF '(($PIECE(ORBEG,".")=$PIECE(OREND,"."))&($PIECE(ORBEG,".")=$$DT^ORWPS("T")))
Begin DoDot:1
+11 SET PARAM("ROC","VA-WH HIRISK IMAGING AGENTS GROUP")=""
SET PARAM("ROC","VA-WH HIRISK MEDICATIONS (EXTREME RISK) GROUP")=""
+12 SET PARAM("ROC","VA-WH HIRISK MEDICATIONS (LACTATION LEVEL 1) GROUP")=""
SET PARAM("ROC","VA-WH HIRISK MEDICATIONS (LACTATION LEVEL 2) GROUP")=""
+13 SET PARAM("ROC","VA-WH HIRISK MEDICATIONS (MOD/HIGH RISK DURING PREGNANCY) GROUP")=""
+14 SET PARAM("ROC RETURN TYPE","GROUPS")=""
SET PARAM("ROC ORDERED WITHIN")=""
+15 SET PARAM("ROC STATUS","*")=""
+16 SET PARAM("ROC DISPLAY GROUPS","PHARMACY","START")=ORBEG
SET PARAM("ROC DISPLAY GROUPS","PHARMACY","STOP")=OREND
End DoDot:1
+17 IF $PIECE(ORBEG,".")=$PIECE(OREND,".")
IF $PIECE(ORBEG,".")=$$DT^ORWPS("T")
Begin DoDot:1
+18 ;,PARAM("ROC EVAL DATES")=DT
SET PARAM("ROC","ALL")=""
+19 SET PARAM("ROC STATUS","HOLD")=""
SET PARAM("ROC STATUS","FLAGGED")=""
SET PARAM("ROC STATUS","PENDING")=""
+20 SET PARAM("ROC STATUS","ACTIVE")=""
SET PARAM("ROC STATUS","DELAYED")=""
SET PARAM("ROC STATUS","RENEWED")=""
+21 SET PARAM("ROC RETURN TYPE","GROUPS")=""
SET PARAM("ROC RETURN TYPE","RULES")=""
End DoDot:1
+22 DO EN^PXRMGEV(.RETURN,.PARAM)
+23 IF $PIECE(@RETURN@(0),U)<1
GOTO GEXIT
+24 SET ORIEN=0
FOR
SET ORIEN=$ORDER(^TMP($JOB,"ORWHRMR",ORIEN))
if '+ORIEN
QUIT
Begin DoDot:1
+25 NEW PSIFN
+26 SET PSIFN=$GET(^OR(100,ORIEN,4))
if '+PSIFN
QUIT
+27 SET INDEX=1+$GET(INDEX)
SET OCINAME=""
+28 FOR
SET OCINAME=$ORDER(^TMP($JOB,"ORWHRMR",ORIEN,NODE,OCINAME))
if OCINAME=""
QUIT
IF $EXTRACT(OCINAME,1,13)="VA-WH HIRISK "
Begin DoDot:2
+29 IF $DATA(PARAM("ROC RETURN TYPE","RULES"))
IF '$DATA(^TMP($JOB,"ORWHRMR",ORIEN,"RULES"))
QUIT
+30 IF '$DATA(^TMP("ORPS",$JOB,INDEX))
Begin DoDot:3
+31 NEW TYPE,NODE,TO
+32 SET TYPE=$PIECE($GET(^OR(100,ORIEN,0)),U,12)
SET TO=$PIECE($GET(^ORD(100.98,+$PIECE($GET(^OR(100,ORIEN,0)),U,11),0)),U)
+33 IF TYPE="O"
IF TO["CLINIC"
SET TYPE="I"
+34 if TYPE="O"
SET PSIFN=$TRANSLATE(PSIFN,"S","P")_$SELECT(PSIFN?1.N:"R",1:"")
+35 SET PSIFN=PSIFN_";"_TYPE
+36 ;DBIA 2400
DO OEL^PSOORRL(DFN,PSIFN)
+37 IF '$DATA(^TMP("PS",$JOB))
QUIT
+38 SET TYPE=$SELECT(TYPE="O":"OP",1:"UD")
+39 IF TYPE="OP"
IF PSIFN["N"
SET TYPE="NV"
+40 IF ($ORDER(^TMP("PS",$JOB,"A",0))>0)!($ORDER(^TMP("PS",$JOB,"B",0))>0)
SET TYPE="IV"
+41 SET NODE=$GET(^TMP("PS",$JOB,0))
+42 SET ^TMP("ORPS",$JOB,INDEX)=TYPE_U_PSIFN_U_$PIECE(NODE,U)_U_$PIECE(NODE,U,3)_U_$PIECE(NODE,U,5,6)_U_$PIECE(NODE,U,12)
+43 if TYPE="NV"
SET $PIECE(^TMP("ORPS",$JOB,INDEX),U,5)=$PIECE($GET(^OR(100,ORIEN,0)),U,8)
+44 IF $PIECE(^TMP("ORPS",$JOB,INDEX),U,6)="PENDING"
SET $PIECE(^(INDEX),U,5)=""
End DoDot:3
+45 if '$DATA(^TMP("ORPS",$JOB,INDEX))
QUIT
+46 IF OCINAME'["(LACT"
SET $PIECE(^TMP("ORPS",$JOB,INDEX),U,8)="*"
+47 IF OCINAME["(LACT"
SET $PIECE(^TMP("ORPS",$JOB,INDEX),U,9)="*"
End DoDot:2
End DoDot:1
GEXIT ;CLEAN-UP FOR GETDATA
+1 KILL ^TMP("PXRHM",$JOB),^TMP("PS",$JOB),^TMP($JOB,"ORWHRMR")
+2 QUIT
FORMAT ;FORMAT DATA FOR RETURN TO CPRS
+1 KILL ^TMP("ORPS",$JOB)
+2 DO @GO
+3 NEW ORSITE,J,RT,X,ORITM
+4 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+5 SET ORITM=0
FOR
SET ORITM=$ORDER(^TMP("ORPS",$JOB,ORITM))
if '+ORITM
QUIT
Begin DoDot:1
+6 ;Station ID
SET ^TMP("ORDATA",$JOB,ORITM,"WP",1)="1^"_ORSITE
+7 ;Medication Name
SET ^TMP("ORDATA",$JOB,ORITM,"WP",2)="2^"_$PIECE(^TMP("ORPS",$JOB,ORITM),U,3)
+8 ;Status
SET ^TMP("ORDATA",$JOB,ORITM,"WP",3)="3^"_$PIECE(^TMP("ORPS",$JOB,ORITM),U,6)
+9 ;In/OutPatient
SET ^TMP("ORDATA",$JOB,ORITM,"WP",4)="4^"_$SELECT($PIECE($PIECE(^TMP("ORPS",$JOB,ORITM),U,2),";",2)="I":"IN",1:"OUT")
+10 ;Type: RX or NonVA Med
SET ^TMP("ORDATA",$JOB,ORITM,"WP",5)="5^"_$SELECT($PIECE(^TMP("ORPS",$JOB,ORITM),U)="NV":"NonVAMed",1:"RX")
+11 ;Teratogenic
SET ^TMP("ORDATA",$JOB,ORITM,"WP",6)="6^"_$PIECE(^TMP("ORPS",$JOB,ORITM),U,8)
+12 ;Lactation
SET ^TMP("ORDATA",$JOB,ORITM,"WP",7)="7^"_$PIECE(^TMP("ORPS",$JOB,ORITM),U,9)
+13 ;Start Date
SET ^TMP("ORDATA",$JOB,ORITM,"WP",8)="8^"_$$DATE^ORDVU($PIECE(^TMP("ORPS",$JOB,ORITM),U,5))
+14 ;Stop Date
SET ^TMP("ORDATA",$JOB,ORITM,"WP",9)="9^"_$$DATE^ORDVU($PIECE(^TMP("ORPS",$JOB,ORITM),U,4))
+15 ;Last Fill Date
SET ^TMP("ORDATA",$JOB,ORITM,"WP",10)="10^"_$$DATE^ORDVU($PIECE(^TMP("ORPS",$JOB,ORITM),U,7))
+16 DO DETAIL^ORWPS(.RT,DFN,$PIECE(^TMP("ORPS",$JOB,ORITM),U,2))
+17 ;Details from Order
SET J=0
FOR
SET J=$ORDER(^TMP("ORXPND",$JOB,J))
if 'J
QUIT
SET X=^(J,0)
SET ^TMP("ORDATA",$JOB,ORITM,"WP",11,J)="11^"_X
+18 KILL ^TMP("ORXPND",$JOB)
+19 ;flag for detail
SET ^TMP("ORDATA",$JOB,ORITM,"WP",12)="12^[+] "
End DoDot:1
+20 KILL ^TMP("ORPS",$JOB)
+21 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+22 QUIT
