DGPFRFA ;ALB/RBS - PRF FLAG ASSIGNMENT REPORT ; 7/26/05 3:41pm
;;5.3;Registration;**425,555,554,960**;Aug 13, 1993;Build 22
; Last Edited: SHRPE/sgm - Jul 9, 2018 13:33
;
; ICR# TYPE DESCRIPTION
;----- ---- ----------------------------------------
; 1519 Sup EN^XUTMDEVQ
; 2055 Sup $$EXTERNAL
;10086 Sup HOME^%ZIS
;
;This routine will be used for selecting sort parameters to produce
; the FLAG ASSIGNMENT REPORT for Patient Record Flags.
;
; DGSORT(label) = value will store the user selected options
; DGSORT("DGCAT") = 1^Category I (National)
; 2^Category II (Local)
; 3^Category I & II
; DGSORT("DGOWN") = 1^Local Facility
; 2^Other Facilities
; 3^All Facilities
; DGSORT("DGSTAT") = 1^Active
; 2^Inactive
; DGSORT("DGFLAG") = A^All Flags
; variable_pointer^flag name
; e.g., 1;DGPF(26.15,
; DGSORT("DGBEG") = start date FM format
; DGSORT("DGEND") = end date FM format
;
;-- no direct entry
QUIT
;
EN ;Entry point
;-- user prompts for report selection sorts
; Input: none
; Output: Report generated using user selected parameters
;
N X,Y,DGCAT,DGFIRST,DGSORT,ZTSAVE
;
;check for database
S DGFIRST=$$DATA^DGPFUT7 I DGFIRST<1 Q
;
;-- prompt for selection of a flag category (I, II, Both)
S DGCAT=$$CAT^DGPFUT7 Q:DGCAT<1 S DGSORT("DGCAT")=DGCAT
;
;-- prompt for selection of a single flag or all flags
; list (A)ll flags if user selects Both Category's
S DGSORT("DGFLAG")="A^All Flags"
I DGCAT<3 D I X=-1 Q
. ; ask for all or single flag
. S X=$$FLAG^DGPFUT7 I X=-1 Q
. S DGSORT("DGFLAG")=X I $E(X)="A" Q
. ; ask for single flag name
. F D Q:+X
. . N CAT S CAT=$S(+DGCAT=1:"I",1:"II")
. . S X=$$ONEFLAG^DGPFUT7(CAT,1) I X=-1 Q
. . I X>0 S DGSORT("DGFLAG")=X Q
. . S X=0 W !?6,"Select another flag."
. . Q
. Q
;
;-- prompt for locally owned assignments or not ; DG*5.3*960
I +DGSORT("DGCAT")=2 S DGSORT("DGOWN")="1^Local Facility"
E S X=$$OWNASGN^DGPFUT7 Q:X<1 S DGSORT("DGOWN")=X
;
;-- prompt for active/inactive ; DG*3.5*960
S X=$$STATUS^DGPFUT7(0) Q:X<1 S DGSORT("DGSTAT")=X
;
;-- prompt for beginning date
W ! S X=$$START^DGPFUT7(DGFIRST,DT) I X<1 Q
S DGSORT("DGBEG")=X
;
;-- prompt for ending date
S X=$$END^DGPFUT7(DGSORT("DGBEG"),DT) I X<1 Q
S DGSORT("DGEND")=X
;
P ;-- prompt for device
;;WARNING: this report expects the device to support 132 column reports
W !!,$TR($T(P+1),";"," "),!
S ZTSAVE("DGSORT(")=""
D EN^XUTMDEVQ("START^DGPFRFA1","Patient Record Flag Assignment Report",.ZTSAVE)
D HOME^%ZIS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFRFA 2747 printed Sep 23, 2025@20:24:30 Page 2
DGPFRFA ;ALB/RBS - PRF FLAG ASSIGNMENT REPORT ; 7/26/05 3:41pm
+1 ;;5.3;Registration;**425,555,554,960**;Aug 13, 1993;Build 22
+2 ; Last Edited: SHRPE/sgm - Jul 9, 2018 13:33
+3 ;
+4 ; ICR# TYPE DESCRIPTION
+5 ;----- ---- ----------------------------------------
+6 ; 1519 Sup EN^XUTMDEVQ
+7 ; 2055 Sup $$EXTERNAL
+8 ;10086 Sup HOME^%ZIS
+9 ;
+10 ;This routine will be used for selecting sort parameters to produce
+11 ; the FLAG ASSIGNMENT REPORT for Patient Record Flags.
+12 ;
+13 ; DGSORT(label) = value will store the user selected options
+14 ; DGSORT("DGCAT") = 1^Category I (National)
+15 ; 2^Category II (Local)
+16 ; 3^Category I & II
+17 ; DGSORT("DGOWN") = 1^Local Facility
+18 ; 2^Other Facilities
+19 ; 3^All Facilities
+20 ; DGSORT("DGSTAT") = 1^Active
+21 ; 2^Inactive
+22 ; DGSORT("DGFLAG") = A^All Flags
+23 ; variable_pointer^flag name
+24 ; e.g., 1;DGPF(26.15,
+25 ; DGSORT("DGBEG") = start date FM format
+26 ; DGSORT("DGEND") = end date FM format
+27 ;
+28 ;-- no direct entry
+29 QUIT
+30 ;
EN ;Entry point
+1 ;-- user prompts for report selection sorts
+2 ; Input: none
+3 ; Output: Report generated using user selected parameters
+4 ;
+5 NEW X,Y,DGCAT,DGFIRST,DGSORT,ZTSAVE
+6 ;
+7 ;check for database
+8 SET DGFIRST=$$DATA^DGPFUT7
IF DGFIRST<1
QUIT
+9 ;
+10 ;-- prompt for selection of a flag category (I, II, Both)
+11 SET DGCAT=$$CAT^DGPFUT7
if DGCAT<1
QUIT
SET DGSORT("DGCAT")=DGCAT
+12 ;
+13 ;-- prompt for selection of a single flag or all flags
+14 ; list (A)ll flags if user selects Both Category's
+15 SET DGSORT("DGFLAG")="A^All Flags"
+16 IF DGCAT<3
Begin DoDot:1
+17 ; ask for all or single flag
+18 SET X=$$FLAG^DGPFUT7
IF X=-1
QUIT
+19 SET DGSORT("DGFLAG")=X
IF $EXTRACT(X)="A"
QUIT
+20 ; ask for single flag name
+21 FOR
Begin DoDot:2
+22 NEW CAT
SET CAT=$SELECT(+DGCAT=1:"I",1:"II")
+23 SET X=$$ONEFLAG^DGPFUT7(CAT,1)
IF X=-1
QUIT
+24 IF X>0
SET DGSORT("DGFLAG")=X
QUIT
+25 SET X=0
WRITE !?6,"Select another flag."
+26 QUIT
End DoDot:2
if +X
QUIT
+27 QUIT
End DoDot:1
IF X=-1
QUIT
+28 ;
+29 ;-- prompt for locally owned assignments or not ; DG*5.3*960
+30 IF +DGSORT("DGCAT")=2
SET DGSORT("DGOWN")="1^Local Facility"
+31 IF '$TEST
SET X=$$OWNASGN^DGPFUT7
if X<1
QUIT
SET DGSORT("DGOWN")=X
+32 ;
+33 ;-- prompt for active/inactive ; DG*3.5*960
+34 SET X=$$STATUS^DGPFUT7(0)
if X<1
QUIT
SET DGSORT("DGSTAT")=X
+35 ;
+36 ;-- prompt for beginning date
+37 WRITE !
SET X=$$START^DGPFUT7(DGFIRST,DT)
IF X<1
QUIT
+38 SET DGSORT("DGBEG")=X
+39 ;
+40 ;-- prompt for ending date
+41 SET X=$$END^DGPFUT7(DGSORT("DGBEG"),DT)
IF X<1
QUIT
+42 SET DGSORT("DGEND")=X
+43 ;
P ;-- prompt for device
+1 ;;WARNING: this report expects the device to support 132 column reports
+2 WRITE !!,$TRANSLATE($TEXT(P+1),";"," "),!
+3 SET ZTSAVE("DGSORT(")=""
+4 DO EN^XUTMDEVQ("START^DGPFRFA1","Patient Record Flag Assignment Report",.ZTSAVE)
+5 DO HOME^%ZIS
+6 QUIT
