ORPDMPHS ;ISP/LMT - PDMP Health Summary Extract ;Apr 24, 2020@13:27:55
;;3.0;ORDER ENTRY/RESULTS REPORTING;**519,550**;Dec 17, 1997;Build 1
;
; This routine uses the following ICRs:
; 3062 - MAIN^TIULAPIS (controlled)
;
Q
;
EN(ORRETURN,DFN,ORFILTER) ;
;
; Input:
; DFN - Patient (#2) IEN
; ORFILTER - Array (Passed by reference). Can filter extract using the values below. Each filter can
; include more than one value. Example: ORFILTER("STATUS")="EXN".
; ORFILTER("STATUS") = E: Error Query; Z: Error Report; C:Canceled Query; X:Canceled Report; N:Never Reviewed;
; A: Auto Created Note; M: Manually Created Note
; (Optional; Defaults to "EZCXNAM")
; ORFILTER("DATES") = StartDT:EndDT (Optional; Defaults to all dates)
; ORFILTER("SHARED") = 1/0 (Optional; Defaults to "10")
;
; Output:
; ^TMP("ORPDMPHS",$J,SUB1,SUB2)=Query D/T_U_User_U_Delegate Of_U_Status (Cancelled, Error, Never Viewed Report, Reviewed Report)_U_Disclosed To
;
N ORAUTHORIZED,ORCNT,ORDISCTO,ORENDDT,ORIEN,ORNODE0,ORQIEN,ORQUERYDT,ORSHARED,ORSTARTDT,ORSTATUS,ORSUB,ORSUMSTAT,ORVIEWED
;
S ORSUB="ORPDMPHS"
K ^TMP(ORSUB,$J)
S ORRETURN=$NA(^TMP(ORSUB,$J))
S ORCNT=0
;
I $G(DFN)="" Q
I $G(ORFILTER("STATUS"))="" S ORFILTER("STATUS")="EZCXNAM"
I $G(ORFILTER("SHARED"))="" S ORFILTER("SHARED")=10
S ORDISCTO=$$GET^XPAR("ALL","OR PDMP DISCLOSED TO","A","I")
;
S ORIEN=$O(^ORD(101.62,"B",DFN,0))
;OR 550 run manual even if not in 101.62
;I 'ORIEN Q
I ORIEN D
.S ORSTARTDT=$P($G(ORFILTER("DATES")),":",1)
.I 'ORSTARTDT S ORSTARTDT=1
.S ORENDDT=$P($G(ORFILTER("DATES")),":",2)
.I 'ORENDDT S ORENDDT=9999999
.I $P(ORENDDT,".",2)="" S ORENDDT=ORENDDT+.24
.S ORQUERYDT=ORSTARTDT-.0000001
.F S ORQUERYDT=$O(^ORD(101.62,ORIEN,1,"B",ORQUERYDT)) Q:'ORQUERYDT!(ORQUERYDT>ORENDDT) D
.. S ORQIEN=0
.. F S ORQIEN=$O(^ORD(101.62,ORIEN,1,"B",ORQUERYDT,ORQIEN)) Q:'ORQIEN D
... S ORNODE0=$G(^ORD(101.62,ORIEN,1,ORQIEN,0))
... S ORSTATUS=$P(ORNODE0,U,4)
... S ORSHARED=+$P(ORNODE0,U,5)
... S ORVIEWED=$P(ORNODE0,U,7)
... S ORAUTHORIZED=$P(ORNODE0,U,8)
... ;
... S ORSUMSTAT=$$GETSTAT(ORSTATUS,ORVIEWED)
... I ORSUMSTAT="" Q
... I ORFILTER("STATUS")'[$P(ORSUMSTAT,U,1) Q
... I ORFILTER("SHARED")'[ORSHARED Q
... ;
... S ORCNT=ORCNT+1
... S ^TMP(ORSUB,$J,ORQUERYDT,ORQIEN)=ORQUERYDT_U_$P(ORNODE0,U,2)_U_$S(ORAUTHORIZED:"",1:$P(ORNODE0,U,3))_U_$P(ORSUMSTAT,U,2)_U_ORDISCTO
;
I ORFILTER("STATUS")["M" D
. D ADDMANUAL(ORSUB,DFN,$G(ORFILTER("DATES")))
;
Q
;
; Get query status
GETSTAT(ORSTATUS,ORVIEWED) ;
I ORVIEWED="QCANCEL" Q "C^Canceled Query"
I ORVIEWED="RCANCEL" Q "X^Canceled Report"
I ORSTATUS<1 Q "E^Error Query"
I ORVIEWED="ERROR" Q "Z^Error Report"
I ORSTATUS>0,ORVIEWED="NO" Q "N^Never Viewed Report"
I ORSTATUS>0,ORVIEWED="YES" Q "A^Note Auto Created"
Q ""
;
; Add manually created PDMP notes to ^TMP result
ADDMANUAL(ORSUB,DFN,ORDATES) ;
;
N ORAUTHOR,ORAUTHORIZED,ORCOSIG,ORDATE,ORDATE1,ORDATE2,ORDISCTO,ORDOC,ORI,ORIDT,ORSTATUS
;
K ^TMP("TIU",$J)
;
S ORDATE2=$P($G(ORDATES),":",1)
I ORDATE2 S ORDATE2=9999999-ORDATE2
S ORDATE1=$P($G(ORDATES),":",2)
I ORDATE1 S ORDATE1=(9999999-ORDATE1)
S ORSTATUS="COMPLETED"
S ORDOC(1)=$$GETNOTE^ORPDMPNT
D MAIN^TIULAPIS(DFN,.ORDOC,.ORSTATUS,ORDATE1,ORDATE2,999,1) ; ICR 3062
;
S ORDISCTO=$$GET^XPAR("ALL","OR PDMP DISCLOSED TO","M","I")
S ORIDT=0
F S ORIDT=$O(^TMP("TIU",$J,ORIDT)) Q:'ORIDT D
. S ORI=0
. F S ORI=$O(^TMP("TIU",$J,ORIDT,ORI)) Q:'ORI D
. . S ORDOC=0
. . F S ORDOC=$O(^TMP("TIU",$J,ORIDT,ORI,ORDOC)) Q:'ORDOC D
. . . S ORAUTHOR=$G(^TMP("TIU",$J,ORIDT,ORI,ORDOC,1202,"I"))
. . . I 'ORAUTHOR Q
. . . S ORCOSIG=$G(^TMP("TIU",$J,ORIDT,ORI,ORDOC,1208,"I"))
. . . S ORDATE=$G(^TMP("TIU",$J,ORIDT,ORI,ORDOC,1301,"I"))
. . . I 'ORDATE Q
. . . ; Check if note was auto created - if it was it would be in 101.62
. . . I '$D(^ORD(101.62,"AT",ORDOC)) D
. . . . S ORAUTHORIZED=$$ISAUTH^ORPDMP(ORAUTHOR)
. . . . S ^TMP(ORSUB,$J,ORDATE,ORDOC_"M")=ORDATE_U_ORAUTHOR_U_$S(ORAUTHORIZED:"",ORCOSIG:ORCOSIG,1:"<See Note>")_U_"Note Manually Created"_U_ORDISCTO
;
K ^TMP("TIU",$J)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORPDMPHS 4398 printed Sep 23, 2025@20:08:47 Page 2
ORPDMPHS ;ISP/LMT - PDMP Health Summary Extract ;Apr 24, 2020@13:27:55
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**519,550**;Dec 17, 1997;Build 1
+2 ;
+3 ; This routine uses the following ICRs:
+4 ; 3062 - MAIN^TIULAPIS (controlled)
+5 ;
+6 QUIT
+7 ;
EN(ORRETURN,DFN,ORFILTER) ;
+1 ;
+2 ; Input:
+3 ; DFN - Patient (#2) IEN
+4 ; ORFILTER - Array (Passed by reference). Can filter extract using the values below. Each filter can
+5 ; include more than one value. Example: ORFILTER("STATUS")="EXN".
+6 ; ORFILTER("STATUS") = E: Error Query; Z: Error Report; C:Canceled Query; X:Canceled Report; N:Never Reviewed;
+7 ; A: Auto Created Note; M: Manually Created Note
+8 ; (Optional; Defaults to "EZCXNAM")
+9 ; ORFILTER("DATES") = StartDT:EndDT (Optional; Defaults to all dates)
+10 ; ORFILTER("SHARED") = 1/0 (Optional; Defaults to "10")
+11 ;
+12 ; Output:
+13 ; ^TMP("ORPDMPHS",$J,SUB1,SUB2)=Query D/T_U_User_U_Delegate Of_U_Status (Cancelled, Error, Never Viewed Report, Reviewed Report)_U_Disclosed To
+14 ;
+15 NEW ORAUTHORIZED,ORCNT,ORDISCTO,ORENDDT,ORIEN,ORNODE0,ORQIEN,ORQUERYDT,ORSHARED,ORSTARTDT,ORSTATUS,ORSUB,ORSUMSTAT,ORVIEWED
+16 ;
+17 SET ORSUB="ORPDMPHS"
+18 KILL ^TMP(ORSUB,$JOB)
+19 SET ORRETURN=$NAME(^TMP(ORSUB,$JOB))
+20 SET ORCNT=0
+21 ;
+22 IF $GET(DFN)=""
QUIT
+23 IF $GET(ORFILTER("STATUS"))=""
SET ORFILTER("STATUS")="EZCXNAM"
+24 IF $GET(ORFILTER("SHARED"))=""
SET ORFILTER("SHARED")=10
+25 SET ORDISCTO=$$GET^XPAR("ALL","OR PDMP DISCLOSED TO","A","I")
+26 ;
+27 SET ORIEN=$ORDER(^ORD(101.62,"B",DFN,0))
+28 ;OR 550 run manual even if not in 101.62
+29 ;I 'ORIEN Q
+30 IF ORIEN
Begin DoDot:1
+31 SET ORSTARTDT=$PIECE($GET(ORFILTER("DATES")),":",1)
+32 IF 'ORSTARTDT
SET ORSTARTDT=1
+33 SET ORENDDT=$PIECE($GET(ORFILTER("DATES")),":",2)
+34 IF 'ORENDDT
SET ORENDDT=9999999
+35 IF $PIECE(ORENDDT,".",2)=""
SET ORENDDT=ORENDDT+.24
+36 SET ORQUERYDT=ORSTARTDT-.0000001
+37 FOR
SET ORQUERYDT=$ORDER(^ORD(101.62,ORIEN,1,"B",ORQUERYDT))
if 'ORQUERYDT!(ORQUERYDT>ORENDDT)
QUIT
Begin DoDot:2
+38 SET ORQIEN=0
+39 FOR
SET ORQIEN=$ORDER(^ORD(101.62,ORIEN,1,"B",ORQUERYDT,ORQIEN))
if 'ORQIEN
QUIT
Begin DoDot:3
+40 SET ORNODE0=$GET(^ORD(101.62,ORIEN,1,ORQIEN,0))
+41 SET ORSTATUS=$PIECE(ORNODE0,U,4)
+42 SET ORSHARED=+$PIECE(ORNODE0,U,5)
+43 SET ORVIEWED=$PIECE(ORNODE0,U,7)
+44 SET ORAUTHORIZED=$PIECE(ORNODE0,U,8)
+45 ;
+46 SET ORSUMSTAT=$$GETSTAT(ORSTATUS,ORVIEWED)
+47 IF ORSUMSTAT=""
QUIT
+48 IF ORFILTER("STATUS")'[$PIECE(ORSUMSTAT,U,1)
QUIT
+49 IF ORFILTER("SHARED")'[ORSHARED
QUIT
+50 ;
+51 SET ORCNT=ORCNT+1
+52 SET ^TMP(ORSUB,$JOB,ORQUERYDT,ORQIEN)=ORQUERYDT_U_$PIECE(ORNODE0,U,2)_U_$SELECT(ORAUTHORIZED:"",1:$PIECE(ORNODE0,U,3))_U_$PIECE(ORSUMSTAT,U,2)_U_ORDISCTO
End DoDot:3
End DoDot:2
End DoDot:1
+53 ;
+54 IF ORFILTER("STATUS")["M"
Begin DoDot:1
+55 DO ADDMANUAL(ORSUB,DFN,$GET(ORFILTER("DATES")))
End DoDot:1
+56 ;
+57 QUIT
+58 ;
+59 ; Get query status
GETSTAT(ORSTATUS,ORVIEWED) ;
+1 IF ORVIEWED="QCANCEL"
QUIT "C^Canceled Query"
+2 IF ORVIEWED="RCANCEL"
QUIT "X^Canceled Report"
+3 IF ORSTATUS<1
QUIT "E^Error Query"
+4 IF ORVIEWED="ERROR"
QUIT "Z^Error Report"
+5 IF ORSTATUS>0
IF ORVIEWED="NO"
QUIT "N^Never Viewed Report"
+6 IF ORSTATUS>0
IF ORVIEWED="YES"
QUIT "A^Note Auto Created"
+7 QUIT ""
+8 ;
+9 ; Add manually created PDMP notes to ^TMP result
ADDMANUAL(ORSUB,DFN,ORDATES) ;
+1 ;
+2 NEW ORAUTHOR,ORAUTHORIZED,ORCOSIG,ORDATE,ORDATE1,ORDATE2,ORDISCTO,ORDOC,ORI,ORIDT,ORSTATUS
+3 ;
+4 KILL ^TMP("TIU",$JOB)
+5 ;
+6 SET ORDATE2=$PIECE($GET(ORDATES),":",1)
+7 IF ORDATE2
SET ORDATE2=9999999-ORDATE2
+8 SET ORDATE1=$PIECE($GET(ORDATES),":",2)
+9 IF ORDATE1
SET ORDATE1=(9999999-ORDATE1)
+10 SET ORSTATUS="COMPLETED"
+11 SET ORDOC(1)=$$GETNOTE^ORPDMPNT
+12 ; ICR 3062
DO MAIN^TIULAPIS(DFN,.ORDOC,.ORSTATUS,ORDATE1,ORDATE2,999,1)
+13 ;
+14 SET ORDISCTO=$$GET^XPAR("ALL","OR PDMP DISCLOSED TO","M","I")
+15 SET ORIDT=0
+16 FOR
SET ORIDT=$ORDER(^TMP("TIU",$JOB,ORIDT))
if 'ORIDT
QUIT
Begin DoDot:1
+17 SET ORI=0
+18 FOR
SET ORI=$ORDER(^TMP("TIU",$JOB,ORIDT,ORI))
if 'ORI
QUIT
Begin DoDot:2
+19 SET ORDOC=0
+20 FOR
SET ORDOC=$ORDER(^TMP("TIU",$JOB,ORIDT,ORI,ORDOC))
if 'ORDOC
QUIT
Begin DoDot:3
+21 SET ORAUTHOR=$GET(^TMP("TIU",$JOB,ORIDT,ORI,ORDOC,1202,"I"))
+22 IF 'ORAUTHOR
QUIT
+23 SET ORCOSIG=$GET(^TMP("TIU",$JOB,ORIDT,ORI,ORDOC,1208,"I"))
+24 SET ORDATE=$GET(^TMP("TIU",$JOB,ORIDT,ORI,ORDOC,1301,"I"))
+25 IF 'ORDATE
QUIT
+26 ; Check if note was auto created - if it was it would be in 101.62
+27 IF '$DATA(^ORD(101.62,"AT",ORDOC))
Begin DoDot:4
+28 SET ORAUTHORIZED=$$ISAUTH^ORPDMP(ORAUTHOR)
+29 SET ^TMP(ORSUB,$JOB,ORDATE,ORDOC_"M")=ORDATE_U_ORAUTHOR_U_$SELECT(ORAUTHORIZED:"",ORCOSIG:ORCOSIG,1:"<See Note>")_U_"Note Manually Created"_U_ORDISCTO
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+30 ;
+31 KILL ^TMP("TIU",$JOB)
+32 ;
+33 QUIT
