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

DGPFRAB1.m

Go to the documentation of this file. 
  1. DGPFRAB1 ;ALB/RBS - PRF APPROVED BY REPORT CONT. ; 6/4/04 11:17am
  1.  ;;5.3;Registration;**554,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  ;This routine will be used to display or print all Patient Record
  1.  ;Flag Assignment History Actions for the Approved By Person who
  1.  ;authorized the new entry or edit of an assignment to the patient.
  1.  ;
  1.  ; Input: The following sort array contains the report parameters:
  1.  ;  DGSORT("DGAPROV") = pointer to NEW PERSON (#200) file^Person Name
  1.  ;                      or
  1.  ;                    = "A" = All approved by persons
  1.  ;  DGSORT("DGCAT") = CATEGORY
  1.  ;                      1^Category I (National)
  1.  ;                      2^Category II (Local)
  1.  ;                      3^Both
  1.  ;  DGSORT("DGSTATUS") = Assignment Status to report on
  1.  ;                         1^Active
  1.  ;                         2^Inactive
  1.  ;                         3^Both
  1.  ;  DGSORT("DGBEG") = BEGINNING DATE  (internal FileMan date)
  1.  ;  DGSORT("DGEND") = ENDING DATE     (internal FileMan date)
  1.  ;
  1.  ; Output:  A formatted report of the Approved By person's assignments
  1.  ;          that they have authorized to be assigned to 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("DGPFRAB1",$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("DGPFRAB1",$J) - temp global containing report output
  1.  ;
  1.  N DGABIEN  ;approved by person ien
  1.  N DGAIEN   ;approved by history assignment ien
  1.  N DGAPROV  ;approved by sort
  1.  N DGBEG    ;sort beginning date
  1.  N DGC      ;var used to check which category is being reported on
  1.  N DGCAT    ;sort flag category
  1.  N DGCATG   ;category 1 or 2
  1.  N DGEND    ;sort ending date
  1.  N DGHIEN   ;history assignment ien
  1.  N DGPFA    ;assignment data array
  1.  N DGPFAH   ;assignment history data array
  1.  N DGQ      ;quit var
  1.  N DGSTAT   ;status of assignment
  1.  N DGSTATUS ;sort status
  1.  N DGSUB    ;loop flag
  1.  N DGX      ;loop var
  1.  ;
  1.  ; setup variables equal to user input parameter subscripts
  1.  ;   "DGAPROV", "DGCAT", "DGSTATUS", "DGBEG", "DGEND"
  1.  S DGX="" F  S DGX=$O(DGSORT(DGX)) Q:DGX=""  S @DGX=DGSORT(DGX)
  1.  ;
  1.  S DGABIEN=+DGAPROV  ; if 0, then All Approved By sort
  1.  S DGC=$S(+DGCAT=3:0,1:+DGCAT)  ; 0=Both categories sort
  1.  S:DGC DGC=$S(DGC=1:26.15,1:26.11)  ; specific file
  1.  S DGSTAT=+DGSTATUS   ; assignments status to report on
  1.  S:DGSTAT=2 DGSTAT=0  ; inactive status value is '0'
  1.  ;
  1.  ; seed var to start at user selected values
  1.  S (DGQ,DGSUB)=0
  1.  S DGSUB=DGBEG-1
  1.  ;
  1.  ; loop history assignment d/t & approve by x-ref file
  1.  F  S DGSUB=$O(^DGPF(26.14,"D",DGSUB)) Q:DGSUB=""  D  Q:DGQ
  1.  . I DGSUB>(DGEND+.999999999) S DGQ=1 Q
  1.  . S DGAIEN=""
  1.  . S:DGABIEN DGAIEN=DGABIEN-1  ;seed var to start before selection
  1.  . F  S DGAIEN=$O(^DGPF(26.14,"D",DGSUB,DGAIEN)) Q:DGAIEN=""  D
  1.  .. I DGABIEN,(DGAIEN>DGABIEN) Q
  1.  .. S DGHIEN=""
  1.  .. F  S DGHIEN=$O(^DGPF(26.14,"D",DGSUB,DGAIEN,DGHIEN)) Q:DGHIEN=""  D
  1.  ...K DGPFAH
  1.  ...Q:'$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH)
  1.  ...I DGABIEN,(+DGPFAH("APPRVBY")'=DGABIEN) Q
  1.  ...K DGPFA
  1.  ...Q:'$$GETASGN^DGPFAA(+DGPFAH("ASSIGN"),.DGPFA)
  1.  ...I DGC,DGPFA("FLAG")'[DGC Q  ;not correct category
  1.  ...I DGSTAT'=3,+DGPFA("STATUS")'=DGSTAT Q  ;not correct status
  1.  ...S DGCATG=$S(DGPFA("FLAG")[26.15:1,1:2)
  1.  ...D BLDTMP(.DGPFA,.DGPFAH,DGHIEN,DGCATG,DGLIST)
  1.  Q
  1.  ;
  1. BLDTMP(DGPFA,DGPFAH,DGHIEN,DGCATG,DGLIST) ; list global builder
  1.  ;  Input:
  1.  ;      DGPFA  - array of assignment record data
  1.  ;      DGPFAH - array of assignment history record data
  1.  ;      DGHIEN - ien to PRF ASSIGNMENT HISTORY (#26.14) file record
  1.  ;      DGCATG - category of flag 1=National, 2=Local
  1.  ;      DGLIST - temp global name used for report list
  1.  ;
  1.  ; Output:
  1.  ;      ^TMP("DGPFRFA1",$J) - temp global containing report output
  1.  ;
  1.  N DG1,DG2 ;subscript var's
  1.  N DGACTDT ;initial entry date
  1.  N DGDFN   ;pointer to patient being reported on
  1.  N DGFGNM  ;flag name
  1.  N DGLINE  ;report detail line
  1.  N DGPAT   ;array of patient demographics
  1.  N DGPNM   ;patient name
  1.  N DGREV   ;review date
  1.  ;
  1.  ; get patient demographics
  1.  S DGDFN=$P(DGPFA("DFN"),U)
  1.  K DGPAT
  1.  Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPAT)
  1.  S DGPNM=DGPAT("NAME")
  1.  S:DGPNM']"" DGPNM="MISSING PATIENT NAME"
  1.  S DGFGNM=$P(DGPFA("FLAG"),U,2)
  1.  S:DGFGNM']"" DGFGNM="MISSING FLAG NAME"
  1.  S DGACTDT=$$FDATE^VALM1(+DGPFAH("ASSIGNDT"))
  1.  I +DGPFA("REVIEWDT") D
  1.  .S DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT"))
  1.  E  S DGREV="N/A"
  1.  S DGLINE=DGPAT("SSN")_U_$P(DGPFAH("ACTION"),U,2)_U_DGACTDT_U_DGREV_U_$P(DGPFA("STATUS"),U,2)
  1.  ; setup subscripts -
  1.  ; - Approved By Name, IEN, Cat, Flag Name, Pat Name, DFN, History IEN
  1.  S DG1=$P(DGPFAH("APPRVBY"),U,2),DG2=$P(DGPFAH("APPRVBY"),U)
  1.  S @DGLIST@(DG1,DG2,DGCATG,DGFGNM,DGPNM,DGDFN,DGHIEN)=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 DGAPNM  ;approved by name
  1.  N DGCAT   ;flag category
  1.  N DGCNT   ;counter of detail lines
  1.  N DGDFN   ;ien of patient
  1.  N DGDT    ;date time report printed
  1.  N DGFG    ;flag name
  1.  N DGIEN   ;approved by ien
  1.  N DGLINE  ;string of hyphens (80) for report header format
  1.  N DGLN    ;loop var
  1.  N DGNAM   ;patient name
  1.  N DGOCAT  ;category switch flag
  1.  N DGODFN  ;loop var flag
  1.  N DGOFG   ;name switch flag
  1.  N DGOIEN  ;ien switch flag
  1.  N DGPAGE  ;page counter
  1.  N DGQ     ;quit flag
  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.  ;
  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 (DGIEN,DGOIEN,DGAPNM,DGCAT,DGOCAT,DGFG,DGOFG,DGNAM,DGDFN,DGODFN,DGLN,DGSTR)=""
  1.  D HEAD
  1.  F  S DGAPNM=$O(@DGLIST@(DGAPNM)) Q:DGAPNM=""  D  Q:DGQ
  1.  . F  S DGIEN=$O(@DGLIST@(DGAPNM,DGIEN)) Q:DGIEN=""  D  Q:DGQ
  1.  . . I $Y>(IOSL-8) D PAUSE(.DGQ) Q:DGQ  D HEAD,HEAD1 S DGOIEN=DGIEN
  1.  . . I DGOIEN'=DGIEN S DGOIEN=DGIEN W:DGCNT ! D HEAD1
  1.  . . F  S DGCAT=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT)) Q:DGCAT=""  D  Q:DGQ
  1.  . . . F  S DGFG=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG)) Q:DGFG=""  D  Q:DGQ
  1.  . . . . I $Y>(IOSL-8) D PAUSE(.DGQ) Q:DGQ  D HEAD,HEAD1,HEAD2 S DGOFG=DGFG
  1.  . . . . I DGOFG'=DGFG W:DGOFG]"" !! D HEAD2 S DGOFG=DGFG
  1.  . . . . ; print patient detail line
  1.  . . . . D PRNTPAT
  1.  . ; reset var's to pop header's
  1.  . S (DGOIEN,DGOCAT,DGOFG)=""
  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. PRNTPAT ; loop and print all patients for flag
  1.  ;
  1.  S DGODFN=""
  1.  F  S DGNAM=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM)) Q:DGNAM=""  D  Q:DGQ
  1.  . F  S DGDFN=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM,DGDFN)) Q:DGDFN=""  D  Q:DGQ
  1.  . . F  S DGLN=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM,DGDFN,DGLN)) Q:DGLN=""  D  Q:DGQ
  1.  . . . I $Y>(IOSL-3) D PAUSE(.DGQ) Q:DGQ  D HEAD,HEAD1,HEAD2 S DGODFN=""
  1.  . . . S DGSTR=$G(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM,DGDFN,DGLN))
  1.  . . . W !
  1.  . . . I DGODFN'=DGDFN S DGODFN=DGDFN D  ;only print name once
  1.  . . . . W $E(DGNAM,1,16),?18,$P(DGSTR,U)
  1.  . . . W ?30,$P(DGSTR,U,2),?48,$P(DGSTR,U,3),?60,$P(DGSTR,U,4),?71,$P(DGSTR,U,5)
  1.  . . . S DGCNT=DGCNT+1
  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.  W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF
  1.  ;
  1.  S DGPAGE=$G(DGPAGE)+1
  1.  W !?25,"PATIENT RECORD FLAGS"
  1.  W !?20,"ASSIGNMENTS APPROVED BY REPORT",?68,"Page: ",$G(DGPAGE)
  1.  W !,"Date Range: ",$$FDATE^VALM1(DGSORT("DGBEG"))_" to "_$$FDATE^VALM1(DGSORT("DGEND"))
  1.  W ?50,"Printed: ",DGDT
  1.  W !,DGLINE
  1.  Q
  1.  ;
  1. HEAD1 W !!,"Approved By: ",DGAPNM
  1.  Q
  1.  ;
  1. HEAD2 W !,"Flag Name: ",$G(DGFG)," - ",$S(+DGCAT=1:"Category I (National)",1:"Category II (Local)")
  1.  ;
  1.  W !!,"PATIENT",?18,"SSN",?30,"ACTION",?48,"ACTION DT",?60,"REVIEW DT",?71,"STATUS"
  1.  W !,"================",?18,"==========",?30,"================",?48,"=========",?60,"=========",?71,"========="
  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