WVUTL12 ;ISP/RFR - TERATOGENIC DRUGS UTILITY FUNCTIONS;Dec 14, 2020@12:09
;;1.0;WOMEN'S HEALTH;**26**;Sep 30, 1998;Build 624
Q
GETORDRS(WVDFN,WVLAC) ;Entry point for retrieving harmful orders
; INPUT: WVLAC - 1 to indicate calling context is lactation
; 0 (default) to indicate calling context is not lactation
; OUTPUT: $$GETORDRS - Global node address where orders are stored
S WVDFN=+$G(WVDFN),WVLAC=+$G(WVLAC)
Q:WVDFN<1 ""
N INPUT,WVRETURN,WVORN,WVORDCHK,WVEXPDATE,WVNODE
S INPUT("SUB")="WVDATA",INPUT("DFN")=WVDFN
S INPUT("ROC","ALL")=""
S INPUT("ROC DISPLAY GROUPS","PHARMACY")="",INPUT("ROC DISPLAY GROUPS","IMAGING")=""
S INPUT("ROC DISPLAY GROUPS","IMAGING","START")=$$GET^XPAR("ALL","WV IMAGING ORDER START DT",1,"I")
S INPUT("ROC DISPLAY GROUPS","IMAGING","STOP")=DT
S INPUT("ROC STATUS","HOLD")=""
S INPUT("ROC STATUS","PENDING")=""
S INPUT("ROC STATUS","SCHEDULED")=""
S INPUT("ROC STATUS","ACTIVE")=""
S INPUT("ROC STATUS","EXPIRED")=""
S INPUT("ROC RETURN TYPE","RULES")="",INPUT("ROC RETURN TYPE","OI")=""
D EN^PXRMGEV(.WVRETURN,.INPUT)
S WVEXPDATE=$$FMADD^XLFDT($$DT^XLFDT,-90)
S WVORN=0 F S WVORN=$O(^TMP($J,"WVDATA",WVORN)) Q:'+WVORN D
.S WVORDCHK=0 F S WVORDCHK=$O(^TMP($J,"WVDATA",WVORN,"RULES",WVORDCHK)) Q:WVORDCHK="" D
..I $E(WVORDCHK,1,13)'="VA-WH HIRISK " K ^TMP($J,"WVDATA",WVORN,"RULES",WVORDCHK) Q
..S WVNODE=$G(^TMP($J,"WVDATA",WVORN))
..I WVORDCHK'["IMAGING" D
...I $P(WVNODE,U,6)="EXPIRED",$P(WVNODE,U,5)<WVEXPDATE K ^TMP($J,"WVDATA",WVORN) Q
...I WVLAC D
....N WVOIN,WVAGENT,WVPKG
....S WVOIN=0 F S WVOIN=$O(^TMP($J,"WVDATA",WVORN,"OI",WVOIN)) Q:'+WVOIN!($G(WVAGENT)) D
.....S WVPKG=$P($G(^TMP($J,"WVDATA",WVORN,"OI",WVOIN)),U,2) Q:WVPKG'["PSP"
.....S WVAGENT=$$IMGAGNT(+WVPKG)
....S ^TMP($J,"WVDATA",WVORN,"IMGAGNT")=+$G(WVAGENT)
..I WVORDCHK["IMAGING",$P(WVNODE,U,6)="EXPIRED" K ^TMP($J,"WVDATA",WVORN)
.I '$D(^TMP($J,"WVDATA",WVORN,"RULES")) K ^TMP($J,"WVDATA",WVORN) Q
I $O(^TMP($J,"WVDATA",0))="" S ^TMP($J,"WVDATA",0)=0
Q $G(WVRETURN)
IMGAGNT(WVOIIEN) ;Return true if the orderable item resolves to an imaging agent
;INPUT: WVOIIEN - IEN of entry in PHARMACY ORDERABLE ITEM file (#50.7)
S WVOIIEN=+$G(WVOIIEN)
Q:WVOIIEN<1 -1
N WVDIENS,WVDIEN,WVRET,WVGNAME
S WVGNAME="VA-WH HIRISK IMAGING AGENTS GROUP"
D ITEMLIST^PXRMAPI("",WVGNAME,"A","WVROCDATA")
D DRGIEN^PSS50P7(WVOIIEN,DT,"WVDRUGS")
I $G(^TMP($J,"WVDRUGS",0))>0 M WVDIENS=^TMP($J,"WVDRUGS") K WVDIENS(0)
K ^TMP($J,"WVDRUGS")
S WVDIEN=0 F S WVDIEN=$O(WVDIENS(WVDIEN)) Q:'+WVDIEN!($G(WVRET)) D
.I $D(^TMP($J,"WVROCDATA",WVGNAME,"P",WVDIEN_";PS(50,")) S WVRET=1 Q ;DRUG IEN
.D DATA^PSS50(WVDIEN,,,,,"WVDRUG")
.I $D(^TMP($J,"WVROCDATA",WVGNAME,"P",$P($G(^TMP($J,"WVDRUG",WVDIEN,25)),U)_";PS(50.605,")) S WVRET=1 ;VA CLASSIFICATION
.I $D(^TMP($J,"WVROCDATA",WVGNAME,"P",$P($G(^TMP($J,"WVDRUG",WVDIEN,20)),U)_";PSNDF(50.6,")) S WVRET=1 ;VA GENERIC
.I $D(^TMP($J,"WVROCDATA",WVGNAME,"P",$P($G(^TMP($J,"WVDRUG",WVDIEN,22)),U)_";PSNDF(60.58,")) S WVRET=1 ;VA PRODUCT
.K ^TMP($J,"WVDRUG")
K ^TMP($J,"WVROCDATA")
Q +$G(WVRET)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVUTL12 3146 printed Apr 09, 2024@21:49:49 Page 2
WVUTL12 ;ISP/RFR - TERATOGENIC DRUGS UTILITY FUNCTIONS;Dec 14, 2020@12:09
+1 ;;1.0;WOMEN'S HEALTH;**26**;Sep 30, 1998;Build 624
+2 QUIT
GETORDRS(WVDFN,WVLAC) ;Entry point for retrieving harmful orders
+1 ; INPUT: WVLAC - 1 to indicate calling context is lactation
+2 ; 0 (default) to indicate calling context is not lactation
+3 ; OUTPUT: $$GETORDRS - Global node address where orders are stored
+4 SET WVDFN=+$GET(WVDFN)
SET WVLAC=+$GET(WVLAC)
+5 if WVDFN<1
QUIT ""
+6 NEW INPUT,WVRETURN,WVORN,WVORDCHK,WVEXPDATE,WVNODE
+7 SET INPUT("SUB")="WVDATA"
SET INPUT("DFN")=WVDFN
+8 SET INPUT("ROC","ALL")=""
+9 SET INPUT("ROC DISPLAY GROUPS","PHARMACY")=""
SET INPUT("ROC DISPLAY GROUPS","IMAGING")=""
+10 SET INPUT("ROC DISPLAY GROUPS","IMAGING","START")=$$GET^XPAR("ALL","WV IMAGING ORDER START DT",1,"I")
+11 SET INPUT("ROC DISPLAY GROUPS","IMAGING","STOP")=DT
+12 SET INPUT("ROC STATUS","HOLD")=""
+13 SET INPUT("ROC STATUS","PENDING")=""
+14 SET INPUT("ROC STATUS","SCHEDULED")=""
+15 SET INPUT("ROC STATUS","ACTIVE")=""
+16 SET INPUT("ROC STATUS","EXPIRED")=""
+17 SET INPUT("ROC RETURN TYPE","RULES")=""
SET INPUT("ROC RETURN TYPE","OI")=""
+18 DO EN^PXRMGEV(.WVRETURN,.INPUT)
+19 SET WVEXPDATE=$$FMADD^XLFDT($$DT^XLFDT,-90)
+20 SET WVORN=0
FOR
SET WVORN=$ORDER(^TMP($JOB,"WVDATA",WVORN))
if '+WVORN
QUIT
Begin DoDot:1
+21 SET WVORDCHK=0
FOR
SET WVORDCHK=$ORDER(^TMP($JOB,"WVDATA",WVORN,"RULES",WVORDCHK))
if WVORDCHK=""
QUIT
Begin DoDot:2
+22 IF $EXTRACT(WVORDCHK,1,13)'="VA-WH HIRISK "
KILL ^TMP($JOB,"WVDATA",WVORN,"RULES",WVORDCHK)
QUIT
+23 SET WVNODE=$GET(^TMP($JOB,"WVDATA",WVORN))
+24 IF WVORDCHK'["IMAGING"
Begin DoDot:3
+25 IF $PIECE(WVNODE,U,6)="EXPIRED"
IF $PIECE(WVNODE,U,5)<WVEXPDATE
KILL ^TMP($JOB,"WVDATA",WVORN)
QUIT
+26 IF WVLAC
Begin DoDot:4
+27 NEW WVOIN,WVAGENT,WVPKG
+28 SET WVOIN=0
FOR
SET WVOIN=$ORDER(^TMP($JOB,"WVDATA",WVORN,"OI",WVOIN))
if '+WVOIN!($GET(WVAGENT))
QUIT
Begin DoDot:5
+29 SET WVPKG=$PIECE($GET(^TMP($JOB,"WVDATA",WVORN,"OI",WVOIN)),U,2)
if WVPKG'["PSP"
QUIT
+30 SET WVAGENT=$$IMGAGNT(+WVPKG)
End DoDot:5
+31 SET ^TMP($JOB,"WVDATA",WVORN,"IMGAGNT")=+$GET(WVAGENT)
End DoDot:4
End DoDot:3
+32 IF WVORDCHK["IMAGING"
IF $PIECE(WVNODE,U,6)="EXPIRED"
KILL ^TMP($JOB,"WVDATA",WVORN)
End DoDot:2
+33 IF '$DATA(^TMP($JOB,"WVDATA",WVORN,"RULES"))
KILL ^TMP($JOB,"WVDATA",WVORN)
QUIT
End DoDot:1
+34 IF $ORDER(^TMP($JOB,"WVDATA",0))=""
SET ^TMP($JOB,"WVDATA",0)=0
+35 QUIT $GET(WVRETURN)
IMGAGNT(WVOIIEN) ;Return true if the orderable item resolves to an imaging agent
+1 ;INPUT: WVOIIEN - IEN of entry in PHARMACY ORDERABLE ITEM file (#50.7)
+2 SET WVOIIEN=+$GET(WVOIIEN)
+3 if WVOIIEN<1
QUIT -1
+4 NEW WVDIENS,WVDIEN,WVRET,WVGNAME
+5 SET WVGNAME="VA-WH HIRISK IMAGING AGENTS GROUP"
+6 DO ITEMLIST^PXRMAPI("",WVGNAME,"A","WVROCDATA")
+7 DO DRGIEN^PSS50P7(WVOIIEN,DT,"WVDRUGS")
+8 IF $GET(^TMP($JOB,"WVDRUGS",0))>0
MERGE WVDIENS=^TMP($JOB,"WVDRUGS")
KILL WVDIENS(0)
+9 KILL ^TMP($JOB,"WVDRUGS")
+10 SET WVDIEN=0
FOR
SET WVDIEN=$ORDER(WVDIENS(WVDIEN))
if '+WVDIEN!($GET(WVRET))
QUIT
Begin DoDot:1
+11 ;DRUG IEN
IF $DATA(^TMP($JOB,"WVROCDATA",WVGNAME,"P",WVDIEN_";PS(50,"))
SET WVRET=1
QUIT
+12 DO DATA^PSS50(WVDIEN,,,,,"WVDRUG")
+13 ;VA CLASSIFICATION
IF $DATA(^TMP($JOB,"WVROCDATA",WVGNAME,"P",$PIECE($GET(^TMP($JOB,"WVDRUG",WVDIEN,25)),U)_";PS(50.605,"))
SET WVRET=1
+14 ;VA GENERIC
IF $DATA(^TMP($JOB,"WVROCDATA",WVGNAME,"P",$PIECE($GET(^TMP($JOB,"WVDRUG",WVDIEN,20)),U)_";PSNDF(50.6,"))
SET WVRET=1
+15 ;VA PRODUCT
IF $DATA(^TMP($JOB,"WVROCDATA",WVGNAME,"P",$PIECE($GET(^TMP($JOB,"WVDRUG",WVDIEN,22)),U)_";PSNDF(60.58,"))
SET WVRET=1
+16 KILL ^TMP($JOB,"WVDRUG")
End DoDot:1
+17 KILL ^TMP($JOB,"WVROCDATA")
+18 QUIT +$GET(WVRET)
