Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPFRPA1

DGPFRPA1.m

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