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 ---[H[J[2J[HGMTSORPD 2360 printed Dec 13, 2024@01:58:35 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 ;
