GMTSORPD.m

GMTSORPD ; ISP/LMT - CPRS PDMP component ;Apr 02, 2020@08:27:12

 ;;2.7;Health Summary;**134**;Oct 20, 1995;Build 25

 ;

 ; This routine uses the following ICRs:

 ;   7144 - EN^ORPDMPHS   (controlled)

 ;

PDMPAODX ; PDMP Accounting of disclosure report when no note was created

 ;

 D PDMPAOD("X")

 ;

 Q

 ;

 ;

PDMPAODA ; All PDMP Accounting of disclosure report, including when note was created manually or automatically

 ;

 D PDMPAOD("A")

 ;

 Q

 ;

 ;

PDMPAOD(GMTSSCREEN) ;

 ; GMTSSCREEN = A: All; X: Exception Cases

 ;

 ; ZEXCEPT: DFN,GMTSBEG,GMTSEND,GMTSQIT

 N GMTSDISCTO,GMTSFILTER,GMTSI,GMTSJ,GMTSNODE,GMTSPG1,GMTSQDT,GMTSRSLTS,GMTSUSER,X

 ;

 S GMTSSCREEN=$G(GMTSSCREEN)

 ;

 S GMTSFILTER("STATUS")="EZCXNAM"  ; Return: Everything

 I GMTSSCREEN="X" S GMTSFILTER("STATUS")="EZCXN"  ; Return: Error, Cancelled, and Never Viewed Report

 S GMTSFILTER("DATES")=GMTSBEG_":"_GMTSEND

 S GMTSFILTER("SHARED")=1

 K ^TMP("ORPDMPHS",$J)

 D EN^ORPDMPHS(.GMTSRSLTS,DFN,.GMTSFILTER)  ;ICR 7144

 ;

 I '$O(^TMP("ORPDMPHS",$J,0)) Q  ; No Data

 ;

 S GMTSPG1=1

 D CKP

 I $D(GMTSQIT) Q

 S GMTSPG1=0

 ;

 S GMTSI=0

 F  S GMTSI=$O(^TMP("ORPDMPHS",$J,GMTSI)) Q:'GMTSI!($D(GMTSQIT))  D

 . S GMTSJ=""

 . F  S GMTSJ=$O(^TMP("ORPDMPHS",$J,GMTSI,GMTSJ)) Q:GMTSJ=""!($D(GMTSQIT))  D

 . . S GMTSNODE=$G(^TMP("ORPDMPHS",$J,GMTSI,GMTSJ))

 . . ;

 . . S X=$P(GMTSNODE,U,1)  ;Query D/T

 . . D REGDTM^GMTSU

 . . S GMTSQDT=X

 . . ;

 . . S GMTSUSER=$P(GMTSNODE,U,2)  ; User

 . . S GMTSUSER=$$NAME^XUSER(GMTSUSER,"F")

 . . S GMTSDISCTO=$P(GMTSNODE,U,5)  ; Disclosed To

 . . ;

 . . D CKP

 . . I $D(GMTSQIT) Q

 . . W GMTSQDT,?16,$E(GMTSUSER,1,25),?43,GMTSDISCTO,!

 ;

 K ^TMP("ORPDMPHS",$J)

 ;

 Q

 ;

 ;

HDR1 ;

 W !,"Info Disclosed: Patient Demographics"

 W !,"Purpose: Accessing Prescription Drug Monitoring Program (PDMP) databases for"

 W !,"         review of controlled substances prescribed outside of the VA, and any"

 W !,"         additional information that may become available, as an important"

 W !,"         component of standard clinical care and in accordance with VHA policy."

 W !!

 Q

 ;

 ;

HDR ;

 W "Date/Time       User/Author                Disclosed To"

 W !!

 Q

 ;

 ;

CKP ;

 ;

 ; ZEXCEPT: GMTSPG1,GMTSNPG,GMTSQIT

 ;

 D CKP^GMTSUP

 I $D(GMTSQIT) Q

 I GMTSPG1 D HDR1

 I GMTSNPG D HDR

 Q

 ;

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---GMTSORPD   2360     printed  Mar 13, 2025@21:03:23                                                                                                                                                                                                    Page 2

GMTSORPD  ; ISP/LMT - CPRS PDMP component ;Apr 02, 2020@08:27:12

 +1       ;;2.7;Health Summary;**134**;Oct 20, 1995;Build 25

 +2       ;

 +3       ; This routine uses the following ICRs:

 +4       ;   7144 - EN^ORPDMPHS   (controlled)

 +5       ;

PDMPAODX  ; PDMP Accounting of disclosure report when no note was created

 +1       ;

 +2        DO PDMPAOD("X")

 +3       ;

 +4        QUIT 

 +5       ;

 +6       ;

PDMPAODA  ; All PDMP Accounting of disclosure report, including when note was created manually or automatically

 +1       ;

 +2        DO PDMPAOD("A")

 +3       ;

 +4        QUIT 

 +5       ;

 +6       ;

PDMPAOD(GMTSSCREEN) ;

 +1       ; GMTSSCREEN = A: All; X: Exception Cases

 +2       ;

 +3       ; ZEXCEPT: DFN,GMTSBEG,GMTSEND,GMTSQIT

 +4        NEW GMTSDISCTO,GMTSFILTER,GMTSI,GMTSJ,GMTSNODE,GMTSPG1,GMTSQDT,GMTSRSLTS,GMTSUSER,X

 +5       ;

 +6        SET GMTSSCREEN=$GET(GMTSSCREEN)

 +7       ;

 +8       ; Return: Everything

           SET GMTSFILTER("STATUS")="EZCXNAM"

 +9       ; Return: Error, Cancelled, and Never Viewed Report

           IF GMTSSCREEN="X"

               SET GMTSFILTER("STATUS")="EZCXN"

 +10       SET GMTSFILTER("DATES")=GMTSBEG_":"_GMTSEND

 +11       SET GMTSFILTER("SHARED")=1

 +12       KILL ^TMP("ORPDMPHS",$JOB)

 +13      ;ICR 7144

           DO EN^ORPDMPHS(.GMTSRSLTS,DFN,.GMTSFILTER)

 +14      ;

 +15      ; No Data

           IF '$ORDER(^TMP("ORPDMPHS",$JOB,0))

               QUIT 

 +16      ;

 +17       SET GMTSPG1=1

 +18       DO CKP

 +19       IF $DATA(GMTSQIT)

               QUIT 

 +20       SET GMTSPG1=0

 +21      ;

 +22       SET GMTSI=0

 +23       FOR 

               SET GMTSI=$ORDER(^TMP("ORPDMPHS",$JOB,GMTSI))

               if 'GMTSI!($DATA(GMTSQIT))

                   QUIT 

               Begin DoDot:1

 +24               SET GMTSJ=""

 +25               FOR 

                       SET GMTSJ=$ORDER(^TMP("ORPDMPHS",$JOB,GMTSI,GMTSJ))

                       if GMTSJ=""!($DATA(GMTSQIT))

                           QUIT 

                       Begin DoDot:2

 +26                       SET GMTSNODE=$GET(^TMP("ORPDMPHS",$JOB,GMTSI,GMTSJ))

 +27      ;

 +28      ;Query D/T

                           SET X=$PIECE(GMTSNODE,U,1)

 +29                       DO REGDTM^GMTSU

 +30                       SET GMTSQDT=X

 +31      ;

 +32      ; User

                           SET GMTSUSER=$PIECE(GMTSNODE,U,2)

 +33                       SET GMTSUSER=$$NAME^XUSER(GMTSUSER,"F")

 +34      ; Disclosed To

                           SET GMTSDISCTO=$PIECE(GMTSNODE,U,5)

 +35      ;

 +36                       DO CKP

 +37                       IF $DATA(GMTSQIT)

                               QUIT 

 +38                       WRITE GMTSQDT,?16,$EXTRACT(GMTSUSER,1,25),?43,GMTSDISCTO,!

                       End DoDot:2

               End DoDot:1

 +39      ;

 +40       KILL ^TMP("ORPDMPHS",$JOB)

 +41      ;

 +42       QUIT 

 +43      ;

 +44      ;

HDR1      ;

 +1        WRITE !,"Info Disclosed: Patient Demographics"

 +2        WRITE !,"Purpose: Accessing Prescription Drug Monitoring Program (PDMP) databases for"

 +3        WRITE !,"         review of controlled substances prescribed outside of the VA, and any"

 +4        WRITE !,"         additional information that may become available, as an important"

 +5        WRITE !,"         component of standard clinical care and in accordance with VHA policy."

 +6        WRITE !!

 +7        QUIT 

 +8       ;

 +9       ;

HDR       ;

 +1        WRITE "Date/Time       User/Author                Disclosed To"

 +2        WRITE !!

 +3        QUIT 

 +4       ;

 +5       ;

CKP       ;

 +1       ;

 +2       ; ZEXCEPT: GMTSPG1,GMTSNPG,GMTSQIT

 +3       ;

 +4        DO CKP^GMTSUP

 +5        IF $DATA(GMTSQIT)

               QUIT 

 +6        IF GMTSPG1

               DO HDR1

 +7        IF GMTSNPG

               DO HDR

 +8        QUIT 

 +9       ;

 +10      ;