DGPFRPA ;ALB/RBS - PRF PATIENT ASSIGNMENTS REPORT ; 5/11/04 3:35pm
;;5.3;Registration;**554**;Aug 13, 1993
;
;This routine will be used for selecting sort parameters to produce
; the DGPF PATIENT ASSIGNMENTS REPORT for Patient Record Flags.
;
; Selection options will provide the ability to report by:
; PATIENT
; STATUS (ASSIGNMENTS)
;
; The following reporting sort array will be built by user prompts:
; DGSORT("DGDFN") = Patient IEN of (#2) file to report on
; DGSORT("DGSTATUS") = Assignment Status to report on
; 1^Active
; 2^Inactive
; 3^Both
;-- no direct entry
QUIT
;
EN ;Entry point
;-- user prompts for report selection sorts
; Input: none
; Output: Report generated using user selected parameters
;
N DGASK ;return value from $$ANSWER^DGPFUT call
N DGDIRA ;DGDIRA - DIR("A") string
N DGDIRB ;DGDIRB - DIR("B") string
N DGDIRH ;DGDIRH - DIR("?") string
N DGDIRO ;DGDIR0 - DIR(0) string
N DGIEN ;assignment ien
N DGIENS ;array of ien's of the patients assignment records
N DGOK ;ok flag for finding assignments to report on
N DGPFA ;assignment array
N DGQ ;quit flag
N DGSORT ;array or report parameters
N SAVEXQY0 ;temp save var
N ZTSAVE ;open array reference of input parameters used by tasking
;
;-- prompt for patient to report on
; suppress display of Active Record Flags in DISPPRF^DGPFAPI
; save variable before temporarily deleting it so that the
; code, Q:'$D(XQY0), in DISPPRF^DGPFAPI will suppress the display
;
K SAVEXQY0
I $D(XQY0) S SAVEXQY0=XQY0 K XQY0 ;save original
;
D SELPAT^DGPFUT1(.DGASK)
;
I $D(SAVEXQY0) S XQY0=SAVEXQY0 K SAVEXQY0 ;restore original
;
Q:(DGASK<1)
; get all assignment ien's for the patient
I '$$GETALL^DGPFAA(DGASK,.DGIENS) D Q
. W !?2,">>> Selected patient has no record flag assignments on file.",*7
;
S DGSORT("DGDFN")=DGASK
;
;-- prompt for selection of the assignment status to report on
S DGDIRA="Select Assignment Status to report on"
S DGDIRB="Both"
S DGDIRH="Enter one of the status selections to report on"
S DGDIRO="S^1:Active;2:Inactive;3:Both"
S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
Q:(DGASK<1)
S DGQ=0
I DGASK'=3 D
. S (DGIEN,DGOK)=0
. F S DGIEN=$O(DGIENS(DGIEN)) Q:'DGIEN D Q:(DGOK!DGQ)
. . ;-get assignment
. . K DGPFA
. . I $$GETASGN^DGPFAA(DGIEN,.DGPFA),$P(DGPFA("STATUS"),U)=DGASK S DGOK=1 Q
. Q:DGOK
. S DGQ=1
. W !?2,">>> Selected patient has no '"_$S(DGASK=1:"Active",1:"Inactive")_"' record flag assignments on file.",*7
;
Q:DGQ
S DGSORT("DGSTATUS")=DGASK_U_$S(DGASK=1:"Active",DGASK=2:"Inactive",DGASK=3:"Both",1:3)
;
K DGASK,DGOK,DGQ,DGIEN,DGIENS,DGDIRA,DGDIRB,DGDIRO,DGDIRH
;
;-- prompt for device
S ZTSAVE("DGSORT(")=""
D EN^XUTMDEVQ("START^DGPFRPA1","Patient Assignments Report",.ZTSAVE)
D HOME^%ZIS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFRPA 2980 printed Sep 23, 2025@20:24:34 Page 2
DGPFRPA ;ALB/RBS - PRF PATIENT ASSIGNMENTS REPORT ; 5/11/04 3:35pm
+1 ;;5.3;Registration;**554**;Aug 13, 1993
+2 ;
+3 ;This routine will be used for selecting sort parameters to produce
+4 ; the DGPF PATIENT ASSIGNMENTS REPORT for Patient Record Flags.
+5 ;
+6 ; Selection options will provide the ability to report by:
+7 ; PATIENT
+8 ; STATUS (ASSIGNMENTS)
+9 ;
+10 ; The following reporting sort array will be built by user prompts:
+11 ; DGSORT("DGDFN") = Patient IEN of (#2) file to report on
+12 ; DGSORT("DGSTATUS") = Assignment Status to report on
+13 ; 1^Active
+14 ; 2^Inactive
+15 ; 3^Both
+16 ;-- no direct entry
+17 QUIT
+18 ;
EN ;Entry point
+1 ;-- user prompts for report selection sorts
+2 ; Input: none
+3 ; Output: Report generated using user selected parameters
+4 ;
+5 ;return value from $$ANSWER^DGPFUT call
NEW DGASK
+6 ;DGDIRA - DIR("A") string
NEW DGDIRA
+7 ;DGDIRB - DIR("B") string
NEW DGDIRB
+8 ;DGDIRH - DIR("?") string
NEW DGDIRH
+9 ;DGDIR0 - DIR(0) string
NEW DGDIRO
+10 ;assignment ien
NEW DGIEN
+11 ;array of ien's of the patients assignment records
NEW DGIENS
+12 ;ok flag for finding assignments to report on
NEW DGOK
+13 ;assignment array
NEW DGPFA
+14 ;quit flag
NEW DGQ
+15 ;array or report parameters
NEW DGSORT
+16 ;temp save var
NEW SAVEXQY0
+17 ;open array reference of input parameters used by tasking
NEW ZTSAVE
+18 ;
+19 ;-- prompt for patient to report on
+20 ; suppress display of Active Record Flags in DISPPRF^DGPFAPI
+21 ; save variable before temporarily deleting it so that the
+22 ; code, Q:'$D(XQY0), in DISPPRF^DGPFAPI will suppress the display
+23 ;
+24 KILL SAVEXQY0
+25 ;save original
IF $DATA(XQY0)
SET SAVEXQY0=XQY0
KILL XQY0
+26 ;
+27 DO SELPAT^DGPFUT1(.DGASK)
+28 ;
+29 ;restore original
IF $DATA(SAVEXQY0)
SET XQY0=SAVEXQY0
KILL SAVEXQY0
+30 ;
+31 if (DGASK<1)
QUIT
+32 ; get all assignment ien's for the patient
+33 IF '$$GETALL^DGPFAA(DGASK,.DGIENS)
Begin DoDot:1
+34 WRITE !?2,">>> Selected patient has no record flag assignments on file.",*7
End DoDot:1
QUIT
+35 ;
+36 SET DGSORT("DGDFN")=DGASK
+37 ;
+38 ;-- prompt for selection of the assignment status to report on
+39 SET DGDIRA="Select Assignment Status to report on"
+40 SET DGDIRB="Both"
+41 SET DGDIRH="Enter one of the status selections to report on"
+42 SET DGDIRO="S^1:Active;2:Inactive;3:Both"
+43 SET DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH)
+44 if (DGASK<1)
QUIT
+45 SET DGQ=0
+46 IF DGASK'=3
Begin DoDot:1
+47 SET (DGIEN,DGOK)=0
+48 FOR
SET DGIEN=$ORDER(DGIENS(DGIEN))
if 'DGIEN
QUIT
Begin DoDot:2
+49 ;-get assignment
+50 KILL DGPFA
+51 IF $$GETASGN^DGPFAA(DGIEN,.DGPFA)
IF $PIECE(DGPFA("STATUS"),U)=DGASK
SET DGOK=1
QUIT
End DoDot:2
if (DGOK!DGQ)
QUIT
+52 if DGOK
QUIT
+53 SET DGQ=1
+54 WRITE !?2,">>> Selected patient has no '"_$SELECT(DGASK=1:"Active",1:"Inactive")_"' record flag assignments on file.",*7
End DoDot:1
+55 ;
+56 if DGQ
QUIT
+57 SET DGSORT("DGSTATUS")=DGASK_U_$SELECT(DGASK=1:"Active",DGASK=2:"Inactive",DGASK=3:"Both",1:3)
+58 ;
+59 KILL DGASK,DGOK,DGQ,DGIEN,DGIENS,DGDIRA,DGDIRB,DGDIRO,DGDIRH
+60 ;
+61 ;-- prompt for device
+62 SET ZTSAVE("DGSORT(")=""
+63 DO EN^XUTMDEVQ("START^DGPFRPA1","Patient Assignments Report",.ZTSAVE)
+64 DO HOME^%ZIS
+65 QUIT
