DGPFRPA1 ;ALB/RBS - PRF PATIENT ASSIGNMENTS REPORT CONT. ; 5/21/04 12:53pm
;;5.3;Registration;**554**;Aug 13, 1993
;
;This routine will be used to display or print all the record flag
;assignments of a patient.
;
; Input: The following sort array contains the report parameters:
; DGSORT("DGDFN") = Patient IEN of (#2) file to report on
; DGSORT("DGSTATUS") = Assignment Status to report on
; = 1;Active, 2:Inactive, 3:Both
;
; Output:
; A formatted report of Record Flag Assignments for a patient.
;
;- no direct entry
QUIT
;
START ; compile and print report
I $E(IOST)="C" D WAIT^DICD
N DGLIST ;temp global name used for report list
S DGLIST=$NA(^TMP("DGPFRPA1",$J))
K @DGLIST
D LOOP(.DGSORT,DGLIST)
D PRINT(.DGSORT,DGLIST)
K @DGLIST
D EXIT
Q
;
LOOP(DGSORT,DGLIST) ;use sort var's for record searching to build list
; Input:
; DGSORT - array of user selected report parameters
; DGLIST - temp global name
;
; Output:
; ^TMP("DGPFRPA1",$J) - temp global used for report output
;
N DGDFN ;pointer to patient being reported on
N DGIEN ;ien of assignment record
N DGIENS ;array of ien's of the patients assignments records
N DGPAT ;patient data array
N DGPFA ;assignment data array
N DGSSN ;patient ssn
N DGSTAT ;status of assignment
N DGSTATUS ;assignment status to report on
N DGX ;loop var
;
; setup variables equal to user input parameter subscripts
; "DGDFN", "DGSTATUS"
S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX)
;
S DGSTAT=+DGSTATUS ; assignments status to report on
S:DGSTAT=2 DGSTAT=0 ; inactive status value is '0'
;
; get patient demographics to setup patient name & ssn
K DGPAT
Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPAT)
; add patient name & ssn to DGSORT for printing
S DGSSN=$E(DGPAT("SSN"),1,3)_"-"_$E(DGPAT("SSN"),4,5)_"-"_$E(DGPAT("SSN"),6,10)
S DGSORT("DGDFN")=DGSORT("DGDFN")_U_DGPAT("NAME")_U_DGSSN
; get list of all assignments for patient
Q:'$$GETALL^DGPFAA(DGDFN,.DGIENS)
S DGIEN=0
F S DGIEN=$O(DGIENS(DGIEN)) Q:'DGIEN D
. ; get assignment record fields
. K DGPFA
. Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA)
. I +DGSTATUS'=3,($P(DGPFA("STATUS"),U)'=DGSTAT) Q
. ; call to build temp global
. D BLDTMP(.DGPFA,DGIEN,DGLIST)
;
Q
;
BLDTMP(DGPFA,DGIEN,DGLIST) ; list global builder
; Input:
; DGPFA - array of assignment record data
; DGIEN - ien pointer to PRF ASSIGNMENT (#26.13) file record
; DGLIST - temp global name used for report list
;
; Output:
; ^TMP("DGPFRPA1",$J) - temp global containing report output
;
N DGACTDT ;initial entry date
N DGAPRVBY ;approved by person name
N DGCATG ;category of flag
N DGFGNM ;flag name
N DGLINE ;report detail display line
N DGPCAT ;print output of category
N DGPFAH ;array of assignment history data
N DGREVDT ;review date
;
; get initial assignment history
Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH)
Q:'$G(DGPFAH("ASSIGNDT"))
S DGACTDT=$$FDATE^VALM1(+DGPFAH("ASSIGNDT"))
S DGREVDT=+DGPFA("REVIEWDT")
S DGREVDT=$S(DGREVDT:$$FDATE^VALM1(DGREVDT),1:"N/A")
S DGFGNM=$P(DGPFA("FLAG"),U,2)
S:DGFGNM']"" DGFGNM="MISSING FLAG NAME"
S DGAPRVBY=$P(DGPFAH("APPRVBY"),U,2)
S:DGAPRVBY']"" DGAPRVBY="Missing Name"
S DGCATG=$S(DGPFA("FLAG")[26.15:1,1:2) ;category
S DGPCAT=$S(DGCATG=1:"I",1:"II")
S DGLINE=$E(DGFGNM,1,15)_U_DGPCAT_U_$E(DGAPRVBY,1,15)_U_DGACTDT_U_DGREVDT_U_$P(DGPFA("STATUS"),U,2)_U_$E($P(DGPFA("OWNER"),U,2),1,15)
S @DGLIST@(DGCATG,+DGPFAH("ASSIGNDT"))=DGLINE
Q
;
PRINT(DGSORT,DGLIST) ;output report
; Input:
; DGSORT - array of user selected report parameters
; DGLIST - temp global name used for report list
;
; Output: Formatted report to user selected device
;
N DGCAT ;flag category
N DGCNT ;flag counter
N DGDFN ;ien of patient
N DGDT ;date time report printed
N DGFG ;flag name
N DGLINE ;string of hyphens (80) for report header format
N DGNAM ;patient name
N DGPAGE ;page counter
N DGQ ;quit flag
N DGSTAT ;status report is run for
N DGSTR ;string of detail line to display
N X,Y
;
S (DGCNT,DGQ,DGPAGE)=0,$P(DGLINE,"-",81)=""
S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
S DGSTAT=+DGSORT("DGSTATUS")
;
I $O(@DGLIST@(""))="" D Q
. D HEAD
. W !!," >>> No Record Flag Assignments were found using the report criteria.",!
;
; loop and print report
S (DGCAT,DGFG,DGNAM,DGDFN,DGSTR)="",DGCNT=0
D HEAD
F S DGCAT=$O(@DGLIST@(DGCAT)) Q:DGCAT="" D Q:DGQ
. F S DGFG=$O(@DGLIST@(DGCAT,DGFG)) Q:DGFG="" D Q:DGQ
.. I $Y>(IOSL-4) D PAUSE(.DGQ) Q:DGQ D HEAD
.. S DGSTR=$G(@DGLIST@(DGCAT,DGFG))
.. S DGCNT=DGCNT+1
.. W !,DGCNT,?3,$E($P(DGSTR,U),1,17),?21,$P(DGSTR,U,2),?25,$E($P(DGSTR,U,3),1,11),?38,$P(DGSTR,U,4),?48,$P(DGSTR,U,5),?59,$P(DGSTR,U,6),?69,$E($P(DGSTR,U,7),1,11)
. Q:DGQ
;
;Shutdown if stop task requested
I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q
;
W !!,"<End of Report>"
Q
;
PAUSE(DGQ) ; pause screen display
; Input:
; DGQ - var used to quit report processing to user CRT
; Output:
; DGQ - passed by reference - 0 = Continue, 1 = Quit
;
I $G(DGPAGE)>0,$E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQ=1
Q
;
HEAD ;Print/Display page header
;
I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
;
W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF
;
S DGPAGE=$G(DGPAGE)+1
W !?25,"PATIENT RECORD FLAGS"
W !?22,"PATIENT ASSIGNMENTS REPORT",?68,"Page: ",$G(DGPAGE)
W !,"Report Selected: "_$S(DGSTAT=1:"ACTIVE",DGSTAT=2:"INACTIVE",1:"Both (ACTIVE & INACTIVE)")
W ?50,"Printed: ",DGDT
W !,DGLINE
W !!,"Patient: ",$P(DGSORT("DGDFN"),U,2)," ",$P(DGSORT("DGDFN"),U,3)
W !!?3,"FLAG NAME",?15,"CATEGORY",?25,"APPROVED BY",?38,"ENTERED",?48,"REVIEW DT",?59,"STATUS",?69,"OWNING SITE"
W !,"------------------",?20,"---",?25,"-----------",?38,"--------",?48,"---------",?59,"--------",?69,"-----------"
Q
;
EXIT ;
I $D(ZTQUEUED) S ZTREQ="@"
I '$D(ZTQUEUED) D
. K %ZIS,POP
. D ^%ZISC,HOME^%ZIS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFRPA1 6199 printed Apr 09, 2024@22:05:36 Page 2
DGPFRPA1 ;ALB/RBS - PRF PATIENT ASSIGNMENTS REPORT CONT. ; 5/21/04 12:53pm
+1 ;;5.3;Registration;**554**;Aug 13, 1993
+2 ;
+3 ;This routine will be used to display or print all the record flag
+4 ;assignments of a patient.
+5 ;
+6 ; Input: The following sort array contains the report parameters:
+7 ; DGSORT("DGDFN") = Patient IEN of (#2) file to report on
+8 ; DGSORT("DGSTATUS") = Assignment Status to report on
+9 ; = 1;Active, 2:Inactive, 3:Both
+10 ;
+11 ; Output:
+12 ; A formatted report of Record Flag Assignments for a patient.
+13 ;
+14 ;- no direct entry
+15 QUIT
+16 ;
START ; compile and print report
+1 IF $EXTRACT(IOST)="C"
DO WAIT^DICD
+2 ;temp global name used for report list
NEW DGLIST
+3 SET DGLIST=$NAME(^TMP("DGPFRPA1",$JOB))
+4 KILL @DGLIST
+5 DO LOOP(.DGSORT,DGLIST)
+6 DO PRINT(.DGSORT,DGLIST)
+7 KILL @DGLIST
+8 DO EXIT
+9 QUIT
+10 ;
LOOP(DGSORT,DGLIST) ;use sort var's for record searching to build list
+1 ; Input:
+2 ; DGSORT - array of user selected report parameters
+3 ; DGLIST - temp global name
+4 ;
+5 ; Output:
+6 ; ^TMP("DGPFRPA1",$J) - temp global used for report output
+7 ;
+8 ;pointer to patient being reported on
NEW DGDFN
+9 ;ien of assignment record
NEW DGIEN
+10 ;array of ien's of the patients assignments records
NEW DGIENS
+11 ;patient data array
NEW DGPAT
+12 ;assignment data array
NEW DGPFA
+13 ;patient ssn
NEW DGSSN
+14 ;status of assignment
NEW DGSTAT
+15 ;assignment status to report on
NEW DGSTATUS
+16 ;loop var
NEW DGX
+17 ;
+18 ; setup variables equal to user input parameter subscripts
+19 ; "DGDFN", "DGSTATUS"
+20 SET DGX=""
FOR
SET DGX=$ORDER(DGSORT(DGX))
if DGX=""
QUIT
SET @DGX=DGSORT(DGX)
+21 ;
+22 ; assignments status to report on
SET DGSTAT=+DGSTATUS
+23 ; inactive status value is '0'
if DGSTAT=2
SET DGSTAT=0
+24 ;
+25 ; get patient demographics to setup patient name & ssn
+26 KILL DGPAT
+27 if '$$GETPAT^DGPFUT2(DGDFN,.DGPAT)
QUIT
+28 ; add patient name & ssn to DGSORT for printing
+29 SET DGSSN=$EXTRACT(DGPAT("SSN"),1,3)_"-"_$EXTRACT(DGPAT("SSN"),4,5)_"-"_$EXTRACT(DGPAT("SSN"),6,10)
+30 SET DGSORT("DGDFN")=DGSORT("DGDFN")_U_DGPAT("NAME")_U_DGSSN
+31 ; get list of all assignments for patient
+32 if '$$GETALL^DGPFAA(DGDFN,.DGIENS)
QUIT
+33 SET DGIEN=0
+34 FOR
SET DGIEN=$ORDER(DGIENS(DGIEN))
if 'DGIEN
QUIT
Begin DoDot:1
+35 ; get assignment record fields
+36 KILL DGPFA
+37 if '$$GETASGN^DGPFAA(DGIEN,.DGPFA)
QUIT
+38 IF +DGSTATUS'=3
IF ($PIECE(DGPFA("STATUS"),U)'=DGSTAT)
QUIT
+39 ; call to build temp global
+40 DO BLDTMP(.DGPFA,DGIEN,DGLIST)
End DoDot:1
+41 ;
+42 QUIT
+43 ;
BLDTMP(DGPFA,DGIEN,DGLIST) ; list global builder
+1 ; Input:
+2 ; DGPFA - array of assignment record data
+3 ; DGIEN - ien pointer to PRF ASSIGNMENT (#26.13) file record
+4 ; DGLIST - temp global name used for report list
+5 ;
+6 ; Output:
+7 ; ^TMP("DGPFRPA1",$J) - temp global containing report output
+8 ;
+9 ;initial entry date
NEW DGACTDT
+10 ;approved by person name
NEW DGAPRVBY
+11 ;category of flag
NEW DGCATG
+12 ;flag name
NEW DGFGNM
+13 ;report detail display line
NEW DGLINE
+14 ;print output of category
NEW DGPCAT
+15 ;array of assignment history data
NEW DGPFAH
+16 ;review date
NEW DGREVDT
+17 ;
+18 ; get initial assignment history
+19 if '$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH)
QUIT
+20 if '$GET(DGPFAH("ASSIGNDT"))
QUIT
+21 SET DGACTDT=$$FDATE^VALM1(+DGPFAH("ASSIGNDT"))
+22 SET DGREVDT=+DGPFA("REVIEWDT")
+23 SET DGREVDT=$SELECT(DGREVDT:$$FDATE^VALM1(DGREVDT),1:"N/A")
+24 SET DGFGNM=$PIECE(DGPFA("FLAG"),U,2)
+25 if DGFGNM']""
SET DGFGNM="MISSING FLAG NAME"
+26 SET DGAPRVBY=$PIECE(DGPFAH("APPRVBY"),U,2)
+27 if DGAPRVBY']""
SET DGAPRVBY="Missing Name"
+28 ;category
SET DGCATG=$SELECT(DGPFA("FLAG")[26.15:1,1:2)
+29 SET DGPCAT=$SELECT(DGCATG=1:"I",1:"II")
+30 SET DGLINE=$EXTRACT(DGFGNM,1,15)_U_DGPCAT_U_$EXTRACT(DGAPRVBY,1,15)_U_DGACTDT_U_DGREVDT_U_$PIECE(DGPFA("STATUS"),U,2)_U_$EXTRACT($PIECE(DGPFA("OWNER"),U,2),1,15)
+31 SET @DGLIST@(DGCATG,+DGPFAH("ASSIGNDT"))=DGLINE
+32 QUIT
+33 ;
PRINT(DGSORT,DGLIST) ;output report
+1 ; Input:
+2 ; DGSORT - array of user selected report parameters
+3 ; DGLIST - temp global name used for report list
+4 ;
+5 ; Output: Formatted report to user selected device
+6 ;
+7 ;flag category
NEW DGCAT
+8 ;flag counter
NEW DGCNT
+9 ;ien of patient
NEW DGDFN
+10 ;date time report printed
NEW DGDT
+11 ;flag name
NEW DGFG
+12 ;string of hyphens (80) for report header format
NEW DGLINE
+13 ;patient name
NEW DGNAM
+14 ;page counter
NEW DGPAGE
+15 ;quit flag
NEW DGQ
+16 ;status report is run for
NEW DGSTAT
+17 ;string of detail line to display
NEW DGSTR
+18 NEW X,Y
+19 ;
+20 SET (DGCNT,DGQ,DGPAGE)=0
SET $PIECE(DGLINE,"-",81)=""
+21 SET DGDT=$PIECE($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
+22 SET DGSTAT=+DGSORT("DGSTATUS")
+23 ;
+24 IF $ORDER(@DGLIST@(""))=""
Begin DoDot:1
+25 DO HEAD
+26 WRITE !!," >>> No Record Flag Assignments were found using the report criteria.",!
End DoDot:1
QUIT
+27 ;
+28 ; loop and print report
+29 SET (DGCAT,DGFG,DGNAM,DGDFN,DGSTR)=""
SET DGCNT=0
+30 DO HEAD
+31 FOR
SET DGCAT=$ORDER(@DGLIST@(DGCAT))
if DGCAT=""
QUIT
Begin DoDot:1
+32 FOR
SET DGFG=$ORDER(@DGLIST@(DGCAT,DGFG))
if DGFG=""
QUIT
Begin DoDot:2
+33 IF $Y>(IOSL-4)
DO PAUSE(.DGQ)
if DGQ
QUIT
DO HEAD
+34 SET DGSTR=$GET(@DGLIST@(DGCAT,DGFG))
+35 SET DGCNT=DGCNT+1
+36 WRITE !,DGCNT,?3,$EXTRACT($PIECE(DGSTR,U),1,17),?21,$PIECE(DGSTR,U,2),?25,$EXTRACT($PIECE(DGSTR,U,3),1,11),?38,$PIECE(DGSTR,U,4),?48,$PIECE(DGSTR,U,5),?59,$PIECE(DGSTR,U,6),?69,$EXTRACT($PIECE(DGSTR,U,7),1,11)
End DoDot:2
if DGQ
QUIT
+37 if DGQ
QUIT
End DoDot:1
if DGQ
QUIT
+38 ;
+39 ;Shutdown if stop task requested
+40 IF DGQ
if $DATA(ZTQUEUED)
WRITE !!,"REPORT STOPPED AT USER REQUEST"
QUIT
+41 ;
+42 WRITE !!,"<End of Report>"
+43 QUIT
+44 ;
PAUSE(DGQ) ; pause screen display
+1 ; Input:
+2 ; DGQ - var used to quit report processing to user CRT
+3 ; Output:
+4 ; DGQ - passed by reference - 0 = Continue, 1 = Quit
+5 ;
+6 IF $GET(DGPAGE)>0
IF $EXTRACT(IOST,1,2)="C-"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
if +Y=0
SET DGQ=1
+7 QUIT
+8 ;
HEAD ;Print/Display page header
+1 ;
+2 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (ZTSTOP,DGQ)=1
QUIT
+3 ;
+4 if '($EXTRACT(IOST,1,2)'="C-"&'DGPAGE)
WRITE @IOF
+5 ;
+6 SET DGPAGE=$GET(DGPAGE)+1
+7 WRITE !?25,"PATIENT RECORD FLAGS"
+8 WRITE !?22,"PATIENT ASSIGNMENTS REPORT",?68,"Page: ",$GET(DGPAGE)
+9 WRITE !,"Report Selected: "_$SELECT(DGSTAT=1:"ACTIVE",DGSTAT=2:"INACTIVE",1:"Both (ACTIVE & INACTIVE)")
+10 WRITE ?50,"Printed: ",DGDT
+11 WRITE !,DGLINE
+12 WRITE !!,"Patient: ",$PIECE(DGSORT("DGDFN"),U,2)," ",$PIECE(DGSORT("DGDFN"),U,3)
+13 WRITE !!?3,"FLAG NAME",?15,"CATEGORY",?25,"APPROVED BY",?38,"ENTERED",?48,"REVIEW DT",?59,"STATUS",?69,"OWNING SITE"
+14 WRITE !,"------------------",?20,"---",?25,"-----------",?38,"--------",?48,"---------",?59,"--------",?69,"-----------"
+15 QUIT
+16 ;
EXIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+3 KILL %ZIS,POP
+4 DO ^%ZISC
DO HOME^%ZIS
End DoDot:1
+5 QUIT
