ORPDMPHS.m

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 ---ORPDMPHS   4398     printed  Mar 13, 2025@21:37:24                                                                                                                                                                                                    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