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

DGPFRFA1.m

Go to the documentation of this file.
  1. DGPFRFA1 ;ALB/RBS - PRF FLAG ASSIGNMENT REPORT CONT. ; 1/21/04 5:14pm
  1. ;;5.3;Registration;**425,554,1007,1015**;Aug 13, 1993;Build 21
  1. ;
  1. ;This routine will compile and produce the FLAG ASSIGNMENT REPORT.
  1. ;This routine will be used to display or print all of the patient
  1. ; assignments for Category I and Category II Patient Record Flags.
  1. ;
  1. ;All sort input was created in routine DGPFRFA.
  1. ; Input: The following array contains the sort var's:
  1. ; DGSORT("DGCAT") = category reporting on (I, II, or (B)oth)
  1. ; DGSORT("DGFLAG") = "A" = (A)ll Flags will be reported on
  1. ; = IEN of a (S)ingle Flag (#26.11)/(#26.15)
  1. ; example: "1;DGPF(26.15,"
  1. ; DGSORT("DGBEG") = Beginning date to report on
  1. ; DGSORT("DGEND") = Ending date to report on
  1. ;
  1. ; Output: A formatted report of Record Flag Assignments to patients.
  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
  1. S DGLIST=$NA(^TMP("DGPFRFA1",$J))
  1. K @DGLIST
  1. D LOOP(.DGSORT)
  1. D PRINT(.DGSORT,DGLIST)
  1. D EXIT
  1. Q
  1. ;
  1. LOOP(DGSORT) ;use sort var's for record searching to build list
  1. ; Input:
  1. ; DGSORT - array of user selected report parameters
  1. ;
  1. ; Output:
  1. ; ^TMP("DGPFRFA1",$J) - temp global containing report output
  1. ;
  1. N DGCAT,DGFLAG,DGBEG,DGEND,DGIEN,DGDFN,DGDFNLST
  1. N DGC,DGF,DGX,DGQ,DGFG,DGSUB,DGCNT
  1. S (DGQ,DGFG,DGSUB,DGCNT)=0
  1. S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX)
  1. S DGC=$S(+DGCAT=3:0,1:+DGCAT) ;0 = both categories (National & Local)
  1. S:DGC DGC=$S(DGC=1:26.15,1:26.11)
  1. S DGF=$P(DGFLAG,U) ;"A"=all flags - "5;DGPF(26.11," is selection
  1. ; re-seed var to start looping before actual selection
  1. D:+DGF
  1. . S DGSUB=$O(^DGPF(26.13,"AFLAG",DGF),-1) ;previous value or NULL
  1. ; ex. DGSUB="5;DGPF(26.11," to loop ^DGPF(26.13,"AFLAG",DGSUB,dfn,ien
  1. ;
  1. S (DGDFN,DGIEN)=""
  1. F S DGSUB=$O(^DGPF(26.13,"AFLAG",DGSUB)) Q:DGSUB="" D Q:DGQ
  1. . I DGC,DGSUB'[DGC Q ;not correct file based on category
  1. . I +DGF,DGSUB'[DGF S:DGSUB>DGF DGQ=1 Q ;don't setup or quit loop
  1. . K DGDFNLST
  1. . S DGCNT=$$ASGNCNT^DGPFLF6(DGSUB,.DGDFNLST) ;get list of dfn's
  1. . Q:'DGCNT
  1. . F S DGDFN=$O(DGDFNLST(DGDFN)) Q:DGDFN="" D
  1. . . S DGIEN=$G(DGDFNLST(DGDFN)) Q:DGIEN=""
  1. . . D BLDTMP(.DGSORT,DGDFN,DGIEN,DGLIST)
  1. K DGDFNLST
  1. Q
  1. ;
  1. BLDTMP(DGSORT,DGDFN,DGIEN,DGLIST) ; list global builder
  1. ; Input:
  1. ; DGSORT - array of user selected report parameters
  1. ; DGDFN - ien of patient in PATIENT (#2) file
  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("DGPFRFA1",$J) - temp global containing report output
  1. ;
  1. N DGPFA,DGPFAH,DGPFPAT,DGPTR,DGINIT,DGCATG,DGLINE,DGNAME,DGREV,DGFG
  1. S (DGPTR,DGINIT,DGCATG,DGLINE,DGNAME,DGREV)=""
  1. K DGPFA,DGPFAH,DGPFPAT
  1. ;retrieve a single assign record
  1. Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA)
  1. ;retrieve initial history assign record
  1. Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH)
  1. ;-- get 'initial assignment' date
  1. S DGPFAH("INITASSIGN")=$G(DGPFAH("ASSIGNDT"))
  1. Q:'DGPFAH("INITASSIGN")
  1. S DGINIT=+DGPFAH("INITASSIGN")
  1. I DGINIT>DGBEG&($P(DGINIT,".")'>DGEND) D
  1. . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPFPAT)
  1. . S DGCATG=$S(DGSUB[26.15:1,1:2)
  1. . S DGFG=$P(DGPFA("FLAG"),U,2)
  1. . S DGNAME=DGPFPAT("NAME")
  1. . S DGINIT=$$FDATE^VALM1(+DGPFAH("INITASSIGN"))
  1. . I +DGPFA("REVIEWDT") D
  1. .. S DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT"))
  1. . E S DGREV="N/A"
  1. . S DGLINE=DGPFPAT("SSN")_U_DGINIT_U_DGREV_U_$P(DGPFA("STATUS"),U,2)
  1. . S DGLINE=DGLINE_U_$P(DGPFA("OWNER"),U,2)
  1. . S @DGLIST@(DGCATG,DGFG,DGNAME,DGDFN)=DGLINE
  1. K DGPFA,DGPFAH,DGPFPAT
  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: Formated report to user selected device
  1. ;
  1. N DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGQ,X,Y,DGPAGE,DGDT,DGCNT,DGOFG,DGGRAND,DGLINE
  1. S (DGCNT,DGQ,DGPAGE,DGGRAND)=0,$P(DGLINE,"-",80)=""
  1. S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
  1. I $O(@DGLIST@(""))="" D Q
  1. . S DGCAT=+DGSORT("DGCAT")
  1. . S DGFG=$S(DGSORT("DGFLAG")="A":"(A)ll Flags",1:$P(DGSORT("DGFLAG"),U,2))
  1. . D HEAD
  1. . W !!," >>> No Record Flag Assignments were found using the report criteria."
  1. ; loop and print report
  1. S (DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGOFG)=""
  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 DGFG'=DGOFG D
  1. ... D:DGCNT SUB(.DGCNT,1)
  1. ... D HEAD
  1. ... S DGOFG=DGFG,DGCNT=0
  1. .. F S DGNAM=$O(@DGLIST@(DGCAT,DGFG,DGNAM)) Q:DGNAM="" D Q:DGQ
  1. ... F S DGDFN=$O(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN)) Q:DGDFN="" D Q:DGQ
  1. .... S DGCNT=DGCNT+1,DGCNT(DGCAT)=$G(DGCNT(DGCAT))+1
  1. .... D:$Y>(IOSL-4) HEAD
  1. .... Q:DGQ
  1. .... S DGSTR=$G(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN))
  1. .... W !,$E(DGNAM,1,20),?22,$P(DGSTR,U),?33,$P(DGSTR,U,2),?43,$P(DGSTR,U,3),?53,$P(DGSTR,U,4),?63,$E($P(DGSTR,U,5),1,17)
  1. . Q:DGQ
  1. . I DGCNT D
  1. .. D SUB(.DGCNT,1)
  1. .. D:DGSORT("DGFLAG")="A" SUB(.DGCNT,2) ;only if (A)ll flags
  1. .. S DGOFG="",DGCNT=0
  1. ;
  1. ;Shutdown if stop task requested
  1. I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q
  1. ;
  1. I +DGSORT("DGCAT")=3 D ; Grand totals (B)oth Categories
  1. . S DGCAT=3,DGFG="All Flags",DGGRAND=1
  1. . D HEAD
  1. . W !!,"REPORT SUMMARY:",!,"---------------"
  1. . F DGCAT=1,2,3 D
  1. .. S:DGCAT'=3 DGCNT(3)=$G(DGCNT(3))+$G(DGCNT(DGCAT))
  1. .. W:DGCAT=3 !?39,"-------"
  1. .. W !,"Total Assignments for Category "
  1. .. W $S(DGCAT=1:"I",DGCAT=2:"II",1:"I & II"),":"
  1. .. W ?40,$J(+$G(DGCNT(DGCAT)),6)
  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. SUB(CNT,TYP) ; print sub-totals
  1. ; Input:
  1. ; CNT - count of records printed
  1. ; TYP - indicator of which total count is being printed
  1. ; Output: Write lines of Sub-Totals and Totals per Flag and Category
  1. ;
  1. N DGTYPE,DGCOUNT
  1. S DGTYPE=$S(TYP=1:"Flag",2:"Category "_$S(DGCAT=1:"I",1:"II"))
  1. S DGCOUNT=$S(TYP=1:CNT,1:DGCNT(DGCAT))
  1. W:TYP=1 !
  1. W !,"Total Assignments for "_DGTYPE_": ",DGCOUNT
  1. Q
  1. ;
  1. I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
  1. D PAUSE(.DGQ)
  1. Q:DGQ
  1. W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF
  1. S DGPAGE=$G(DGPAGE)+1
  1. W !?25,"PATIENT RECORD FLAGS"
  1. W !?24,"FLAG ASSIGNMENT REPORT",?70,"Page: ",$G(DGPAGE)
  1. W !?24,"----------------------",?48,"Printed: ",DGDT
  1. W !?2,"CATEGORY: "_$S($G(DGCAT)=1:"Category I (National)",$G(DGCAT)=2:"Category II (Local)",1:"Both (Category I & II)")
  1. W !,"DATE RANGE: ",$$FDATE^VALM1($G(DGSORT("DGBEG")))_" TO "_$$FDATE^VALM1($G(DGSORT("DGEND")))
  1. W !?1,"FLAG NAME: ",$G(DGFG),!
  1. I DGGRAND W DGLINE Q
  1. ;IHS/OIT/LJF 12/22/2006 PATCH 1007 changed SSN to CHART #
  1. ;W !,"PATIENT NAME",?22,"SSN",?33,"ASSIGNED",?43,"REVIEW DT",?53,"STATUS",?63,"OWNING SITE"
  1. W !,"PATIENT NAME",?22,"CHART #",?33,"ASSIGNED",?43,"REVIEW DT",?53,"STATUS",?63,"OWNING SITE"
  1. W !,"--------------------",?22,"---------",?33,"--------",?43,"--------",?53,"--------",?63,"-----------------"
  1. Q
  1. ;
  1. EXIT ;
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. K @DGLIST
  1. I '$D(ZTQUEUED) D
  1. . K %ZIS,POP
  1. . D ^%ZISC,HOME^%ZIS
  1. Q