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

DGPFRAL1.m

Go to the documentation of this file.
  1. DGPFRAL1 ;ALB/RBS - PRF ACTION NOT LINKED REPORT CONT. ; 10/12/05 2:48pm
  1. ;;5.3;Registration;**554,650,1015**;Aug 13, 1993;Build 21
  1. ;
  1. ;This routine will be used to display or print all of the patient
  1. ;assignment history records that are not linked to a progress note.
  1. ;
  1. ; Input: The following sort array contains the report parameters:
  1. ; DGSORT("DGCAT") = Flag Category to report on
  1. ; = 1:National, 2:Local, 3:Both
  1. ; DGSORT("DGBEG") = Beginning date to report on
  1. ; DGSORT("DGEND") = Ending date to report on
  1. ;
  1. ; Output: A formatted report of patient Assignment History Actions
  1. ; that are not linked to a TIU Progress Note.
  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("DGPFRAL1",$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("DGPFRAL1",$J) - temp global containing report output
  1. ;
  1. N DGBEG ;beginning date
  1. N DGC ;var used to check which category is being reported on
  1. N DGCAT ;flag category
  1. N DGCATG ;category 1 or 2
  1. N DGCNT ;flag counter
  1. N DGDFN ;pointer to patient being reported on
  1. N DGDFNLST ;array of dfn's assigned to the flag
  1. N DGEND ;ending date
  1. N DGHIENS ;array subscripted by assignment history date
  1. N DGIEN ;assignment ien
  1. N DGPAT ;patient data array
  1. N DGPFA ;assignment data array
  1. N DGQ ;quit var
  1. N DGSUB ;loop flag
  1. N DGX ;loop var
  1. ;
  1. ; setup variables equal to user input parameter subscripts
  1. ; "DGCAT", "DGBEG", "DGEND"
  1. S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX)
  1. S DGC=$S(+DGCAT=3:0,1:+DGCAT)
  1. S:DGC DGC=$S(DGC=1:26.15,1:26.11)
  1. ;
  1. ; loop assignment variable pointer flag x-ref file to run report
  1. S (DGDFN,DGIEN)="",(DGQ,DGSUB,DGCNT)=0
  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. . S DGCATG=$S(DGSUB[26.15:1,1:2)
  1. . K DGDFNLST
  1. . S DGCNT=$$ASGNCNT^DGPFLF6(DGSUB,.DGDFNLST)
  1. . Q:'DGCNT
  1. . S DGDFN=""
  1. . F S DGDFN=$O(DGDFNLST(DGDFN)) Q:DGDFN="" D
  1. . . S DGIEN=$G(DGDFNLST(DGDFN)) Q:DGIEN=""
  1. . . ; get assignment record
  1. . . K DGPFA
  1. . . Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA)
  1. . . ; check if calling site is owner site
  1. . . Q:'$$ISDIV^DGPFUT($P(DGPFA("OWNER"),U))
  1. . . ;
  1. . . ;filter patient when last action is ENTERED IN ERROR
  1. . . Q:$$ENTINERR(DGIEN)
  1. . . ;
  1. . . ;action ien array subscripted by assignment history date
  1. . . K DGHIENS
  1. . . Q:'$$GETALLDT^DGPFAAH(DGIEN,.DGHIENS)
  1. . . ; check if any Action's fall within the Begin and End dates
  1. . . I $P($O(DGHIENS("")),".")'>DGEND&($P($O(DGHIENS(""),-1),".")'<DGBEG) D
  1. . . . ;delete any action that is not within Begin and End dates
  1. . . . S DGX=0 F S DGX=$O(DGHIENS(DGX)) Q:DGX="" D
  1. . . . . I $P(DGX,".")<DGBEG!($P(DGX,".")>DGEND) K DGHIENS(DGX)
  1. . . . Q:'$O(DGHIENS(""))
  1. . . . ;
  1. . . . ; get patient demographics
  1. . . . K DGPAT
  1. . . . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPAT)
  1. . . . ;
  1. . . . ; call to build temp global
  1. . . . D BLDTMP(.DGPFA,.DGPAT,.DGHIENS,DGCATG,DGLIST)
  1. ;
  1. Q
  1. ;
  1. BLDTMP(DGPFA,DGPAT,DGHIENS,DGCATG,DGLIST) ; list global builder
  1. ; Input:
  1. ; DGPFA - array of assignment record data
  1. ; DGPAT - array of patient demographics
  1. ; DGHIENS - array of history action IEN's sorted by d/t
  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 DGACTDT ;initial entry date
  1. N DGFGNM ;flag name
  1. N DGHIEN ;assignment ien
  1. N DGLINE ;report detail line
  1. N DGLNCNT ;unique subscript counter
  1. N DGPDFN ;pointer to patient
  1. N DGPFAH ;assignment history record data
  1. N DGPNM ;patient name
  1. ;
  1. ; loop all assignment history ien's
  1. S DGHIEN="",DGLNCNT=0
  1. F S DGHIEN=$O(DGHIENS(DGHIEN)) Q:DGHIEN="" D
  1. . ; get assignment history record
  1. . K DGPFAH
  1. . Q:'$$GETHIST^DGPFAAH(DGHIENS(DGHIEN),.DGPFAH)
  1. . Q:+$G(DGPFAH("TIULINK")) ;progress note pointer is setup
  1. . Q:+$G(DGPFAH("ACTION"))=5 ;don't report on ENTERED IN ERROR action
  1. . S DGACTDT=$$FDATE^VALM1(+DGPFAH("ASSIGNDT"))
  1. . S DGPNM=DGPAT("NAME")
  1. . S:DGPNM']"" DGPNM="MISSING PATIENT NAME"
  1. . S DGPDFN=$P(DGPFA("DFN"),U)
  1. . S DGFGNM=$P(DGPFA("FLAG"),U,2)
  1. . S:DGFGNM']"" DGFGNM="MISSING FLAG NAME"
  1. . S DGLINE=DGPAT("SSN")_U_$E(DGFGNM,1,17)_U_$P(DGPFAH("ACTION"),U,2)_U_DGACTDT
  1. . S DGLNCNT=DGLNCNT+1
  1. . S @DGLIST@(DGCATG,DGFGNM,DGPNM,DGPDFN,DGLNCNT)=DGLINE
  1. ;
  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 ;counter of detail lines
  1. N DGDFN ;ien of patient
  1. N DGDT ;date time report printed
  1. N DGFG ;flag name
  1. N DGGRAND ;flag to print grand totals
  1. N DGLINE ;string of hyphens (80) for report header format
  1. N DGLN ;loop var
  1. N DGNAM ;patient name
  1. N DGODFN ;print loop var flag
  1. N DGOFG ;print loop var flag
  1. N DGPCAT ;print form of category
  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,DGGRAND)=0,$P(DGLINE,"-",81)=""
  1. S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
  1. S (DGCAT,DGPCAT)=+DGSORT("DGCAT")
  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,DGODFN,DGOFG,DGLN,DGSTR)=""
  1. F S DGCAT=$O(@DGLIST@(DGCAT)) Q:DGCAT="" D Q:DGQ
  1. . D HEAD S DGCNT=0
  1. . F S DGFG=$O(@DGLIST@(DGCAT,DGFG)) Q:DGFG="" D Q:DGQ
  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. .... F S DGLN=$O(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN,DGLN)) Q:DGLN="" D Q:DGQ
  1. ..... S DGSTR=$G(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN,DGLN))
  1. ..... W !
  1. ..... I $Y>(IOSL-4) D PAUSE(.DGQ) Q:DGQ D HEAD S DGODFN="" W !
  1. ..... ; - write name and ssn once
  1. ..... I DGODFN'=DGDFN S DGODFN=DGDFN,DGOFG=DGFG D
  1. ...... W $E(DGNAM,1,18),?20,$P(DGSTR,U),?32,$E($P(DGSTR,U,2),1,17)
  1. ..... ; - write new flag name
  1. ..... I DGOFG'=DGFG S DGOFG=DGFG W ?32,$E($P(DGSTR,U,2),1,17)
  1. ..... ; - write action detail
  1. ..... W ?51,$P(DGSTR,U,3),?69,$P(DGSTR,U,4)
  1. ..... S DGCNT=DGCNT+1,DGCNT(DGCAT)=$G(DGCNT(DGCAT))+1
  1. . Q:DGQ
  1. . I DGCNT D
  1. .. W !!,"Total Actions not Linked for Category "_$S(DGCAT=1:"I",1:"II")_": ",?46,$J(+$G(DGCNT(DGCAT)),6)
  1. .. S DGCNT=0,DGODFN=""
  1. .. D:DGPCAT=3 PAUSE(.DGQ)
  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,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 !?48,"-------"
  1. .. W !,"Total Actions not Linked for Category "
  1. .. W $S(DGCAT=1:"I",DGCAT=2:"II",1:"I & II"),":"
  1. .. W ?49,$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. ;
  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 !?8,"ASSIGNMENT ACTION NOT LINKED TO A PROGRESS NOTE REPORT",?68,"Page: ",$G(DGPAGE)
  1. W !,"Report Selected: "_$S($G(DGPCAT)=1:"Category I (National)",$G(DGPCAT)=2:"Category II (Local)",1:"Both (Category I & II)")
  1. W !?5,"DATE RANGE: ",$$FDATE^VALM1($G(DGSORT("DGBEG")))_" TO "_$$FDATE^VALM1($G(DGSORT("DGEND")))
  1. W ?50,"Printed: ",DGDT
  1. W !,DGLINE
  1. ;
  1. Q:DGGRAND
  1. ;
  1. W !!,"CATEGORY: "_$S($G(DGCAT)=1:"Category I (National)",$G(DGCAT)=2:"Category II (Local)",1:"Both (Category I & II)")
  1. W !!,"PATIENT",?20,"SSN",?32,"FLAG NAME",?51,"ACTION",?69,"ACTION DATE"
  1. W !,"------------------",?20,"----------",?32,"-----------------",?51,"----------------",?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
  1. ;
  1. ENTINERR(DGIEN) ;is last action ENTERED IN ERROR
  1. ; Input:
  1. ; DGIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file
  1. ;
  1. ; Output:
  1. ; Function Value - Return 1 on success, 0 on failure
  1. ;
  1. N DGPFAH
  1. ;
  1. I $$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGIEN),.DGPFAH)
  1. Q +$G(DGPFAH("ACTION"))=5