| [613] | 1 | DGPFRFA1 ;ALB/RBS - PRF FLAG ASSIGNMENT REPORT CONT. ; 1/21/04 5:14pm
|
|---|
| 2 | ;;5.3;Registration;**425,554**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;This routine will compile and produce the FLAG ASSIGNMENT REPORT.
|
|---|
| 5 | ;This routine will be used to display or print all of the patient
|
|---|
| 6 | ; assignments for Category I and Category II Patient Record Flags.
|
|---|
| 7 | ;
|
|---|
| 8 | ;All sort input was created in routine DGPFRFA.
|
|---|
| 9 | ; Input: The following array contains the sort var's:
|
|---|
| 10 | ; DGSORT("DGCAT") = category reporting on (I, II, or (B)oth)
|
|---|
| 11 | ; DGSORT("DGFLAG") = "A" = (A)ll Flags will be reported on
|
|---|
| 12 | ; = IEN of a (S)ingle Flag (#26.11)/(#26.15)
|
|---|
| 13 | ; example: "1;DGPF(26.15,"
|
|---|
| 14 | ; DGSORT("DGBEG") = Beginning date to report on
|
|---|
| 15 | ; DGSORT("DGEND") = Ending date to report on
|
|---|
| 16 | ;
|
|---|
| 17 | ; Output: A formatted report of Record Flag Assignments to patients.
|
|---|
| 18 | ;
|
|---|
| 19 | ;- no direct entry
|
|---|
| 20 | QUIT
|
|---|
| 21 | ;
|
|---|
| 22 | START ; compile and print report
|
|---|
| 23 | I $E(IOST)="C" D WAIT^DICD
|
|---|
| 24 | N DGLIST
|
|---|
| 25 | S DGLIST=$NA(^TMP("DGPFRFA1",$J))
|
|---|
| 26 | K @DGLIST
|
|---|
| 27 | D LOOP(.DGSORT)
|
|---|
| 28 | D PRINT(.DGSORT,DGLIST)
|
|---|
| 29 | D EXIT
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | LOOP(DGSORT) ;use sort var's for record searching to build list
|
|---|
| 33 | ; Input:
|
|---|
| 34 | ; DGSORT - array of user selected report parameters
|
|---|
| 35 | ;
|
|---|
| 36 | ; Output:
|
|---|
| 37 | ; ^TMP("DGPFRFA1",$J) - temp global containing report output
|
|---|
| 38 | ;
|
|---|
| 39 | N DGCAT,DGFLAG,DGBEG,DGEND,DGIEN,DGDFN,DGDFNLST
|
|---|
| 40 | N DGC,DGF,DGX,DGQ,DGFG,DGSUB,DGCNT
|
|---|
| 41 | S (DGQ,DGFG,DGSUB,DGCNT)=0
|
|---|
| 42 | S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX)
|
|---|
| 43 | S DGC=$S(+DGCAT=3:0,1:+DGCAT) ;0 = both categories (National & Local)
|
|---|
| 44 | S:DGC DGC=$S(DGC=1:26.15,1:26.11)
|
|---|
| 45 | S DGF=$P(DGFLAG,U) ;"A"=all flags - "5;DGPF(26.11," is selection
|
|---|
| 46 | ; re-seed var to start looping before actual selection
|
|---|
| 47 | D:+DGF
|
|---|
| 48 | . S DGSUB=$O(^DGPF(26.13,"AFLAG",DGF),-1) ;previous value or NULL
|
|---|
| 49 | ; ex. DGSUB="5;DGPF(26.11," to loop ^DGPF(26.13,"AFLAG",DGSUB,dfn,ien
|
|---|
| 50 | ;
|
|---|
| 51 | S (DGDFN,DGIEN)=""
|
|---|
| 52 | F S DGSUB=$O(^DGPF(26.13,"AFLAG",DGSUB)) Q:DGSUB="" D Q:DGQ
|
|---|
| 53 | . I DGC,DGSUB'[DGC Q ;not correct file based on category
|
|---|
| 54 | . I +DGF,DGSUB'[DGF S:DGSUB>DGF DGQ=1 Q ;don't setup or quit loop
|
|---|
| 55 | . K DGDFNLST
|
|---|
| 56 | . S DGCNT=$$ASGNCNT^DGPFLF6(DGSUB,.DGDFNLST) ;get list of dfn's
|
|---|
| 57 | . Q:'DGCNT
|
|---|
| 58 | . F S DGDFN=$O(DGDFNLST(DGDFN)) Q:DGDFN="" D
|
|---|
| 59 | . . S DGIEN=$G(DGDFNLST(DGDFN)) Q:DGIEN=""
|
|---|
| 60 | . . D BLDTMP(.DGSORT,DGDFN,DGIEN,DGLIST)
|
|---|
| 61 | K DGDFNLST
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | BLDTMP(DGSORT,DGDFN,DGIEN,DGLIST) ; list global builder
|
|---|
| 65 | ; Input:
|
|---|
| 66 | ; DGSORT - array of user selected report parameters
|
|---|
| 67 | ; DGDFN - ien of patient in PATIENT (#2) file
|
|---|
| 68 | ; DGIEN - ien pointer to PRF ASSIGNMENT (#26.13) file record
|
|---|
| 69 | ; DGLIST - temp global name used for report list
|
|---|
| 70 | ;
|
|---|
| 71 | ; Output:
|
|---|
| 72 | ; ^TMP("DGPFRFA1",$J) - temp global containing report output
|
|---|
| 73 | ;
|
|---|
| 74 | N DGPFA,DGPFAH,DGPFPAT,DGPTR,DGINIT,DGCATG,DGLINE,DGNAME,DGREV,DGFG
|
|---|
| 75 | S (DGPTR,DGINIT,DGCATG,DGLINE,DGNAME,DGREV)=""
|
|---|
| 76 | K DGPFA,DGPFAH,DGPFPAT
|
|---|
| 77 | ;retrieve a single assign record
|
|---|
| 78 | Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA)
|
|---|
| 79 | ;retrieve initial history assign record
|
|---|
| 80 | Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGIEN),.DGPFAH)
|
|---|
| 81 | ;-- get 'initial assignment' date
|
|---|
| 82 | S DGPFAH("INITASSIGN")=$G(DGPFAH("ASSIGNDT"))
|
|---|
| 83 | Q:'DGPFAH("INITASSIGN")
|
|---|
| 84 | S DGINIT=+DGPFAH("INITASSIGN")
|
|---|
| 85 | I DGINIT>DGBEG&($P(DGINIT,".")'>DGEND) D
|
|---|
| 86 | . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPFPAT)
|
|---|
| 87 | . S DGCATG=$S(DGSUB[26.15:1,1:2)
|
|---|
| 88 | . S DGFG=$P(DGPFA("FLAG"),U,2)
|
|---|
| 89 | . S DGNAME=DGPFPAT("NAME")
|
|---|
| 90 | . S DGINIT=$$FDATE^VALM1(+DGPFAH("INITASSIGN"))
|
|---|
| 91 | . I +DGPFA("REVIEWDT") D
|
|---|
| 92 | .. S DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT"))
|
|---|
| 93 | . E S DGREV="N/A"
|
|---|
| 94 | . S DGLINE=DGPFPAT("SSN")_U_DGINIT_U_DGREV_U_$P(DGPFA("STATUS"),U,2)
|
|---|
| 95 | . S DGLINE=DGLINE_U_$P(DGPFA("OWNER"),U,2)
|
|---|
| 96 | . S @DGLIST@(DGCATG,DGFG,DGNAME,DGDFN)=DGLINE
|
|---|
| 97 | K DGPFA,DGPFAH,DGPFPAT
|
|---|
| 98 | Q
|
|---|
| 99 | ;
|
|---|
| 100 | PRINT(DGSORT,DGLIST) ;output report
|
|---|
| 101 | ; Input:
|
|---|
| 102 | ; DGSORT - array of user selected report parameters
|
|---|
| 103 | ; DGLIST - temp global name used for report list
|
|---|
| 104 | ;
|
|---|
| 105 | ; Output: Formated report to user selected device
|
|---|
| 106 | ;
|
|---|
| 107 | N DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGQ,X,Y,DGPAGE,DGDT,DGCNT,DGOFG,DGGRAND,DGLINE
|
|---|
| 108 | S (DGCNT,DGQ,DGPAGE,DGGRAND)=0,$P(DGLINE,"-",80)=""
|
|---|
| 109 | S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
|
|---|
| 110 | I $O(@DGLIST@(""))="" D Q
|
|---|
| 111 | . S DGCAT=+DGSORT("DGCAT")
|
|---|
| 112 | . S DGFG=$S(DGSORT("DGFLAG")="A":"(A)ll Flags",1:$P(DGSORT("DGFLAG"),U,2))
|
|---|
| 113 | . D HEAD
|
|---|
| 114 | . W !!," >>> No Record Flag Assignments were found using the report criteria."
|
|---|
| 115 | ; loop and print report
|
|---|
| 116 | S (DGCAT,DGFG,DGNAM,DGDFN,DGSTR,DGOFG)=""
|
|---|
| 117 | F S DGCAT=$O(@DGLIST@(DGCAT)) Q:DGCAT="" D Q:DGQ
|
|---|
| 118 | . F S DGFG=$O(@DGLIST@(DGCAT,DGFG)) Q:DGFG="" D Q:DGQ
|
|---|
| 119 | .. I DGFG'=DGOFG D
|
|---|
| 120 | ... D:DGCNT SUB(.DGCNT,1)
|
|---|
| 121 | ... D HEAD
|
|---|
| 122 | ... S DGOFG=DGFG,DGCNT=0
|
|---|
| 123 | .. F S DGNAM=$O(@DGLIST@(DGCAT,DGFG,DGNAM)) Q:DGNAM="" D Q:DGQ
|
|---|
| 124 | ... F S DGDFN=$O(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN)) Q:DGDFN="" D Q:DGQ
|
|---|
| 125 | .... S DGCNT=DGCNT+1,DGCNT(DGCAT)=$G(DGCNT(DGCAT))+1
|
|---|
| 126 | .... D:$Y>(IOSL-4) HEAD
|
|---|
| 127 | .... Q:DGQ
|
|---|
| 128 | .... S DGSTR=$G(@DGLIST@(DGCAT,DGFG,DGNAM,DGDFN))
|
|---|
| 129 | .... 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)
|
|---|
| 130 | . Q:DGQ
|
|---|
| 131 | . I DGCNT D
|
|---|
| 132 | .. D SUB(.DGCNT,1)
|
|---|
| 133 | .. D:DGSORT("DGFLAG")="A" SUB(.DGCNT,2) ;only if (A)ll flags
|
|---|
| 134 | .. S DGOFG="",DGCNT=0
|
|---|
| 135 | ;
|
|---|
| 136 | ;Shutdown if stop task requested
|
|---|
| 137 | I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q
|
|---|
| 138 | ;
|
|---|
| 139 | I +DGSORT("DGCAT")=3 D ; Grand totals (B)oth Categories
|
|---|
| 140 | . S DGCAT=3,DGFG="All Flags",DGGRAND=1
|
|---|
| 141 | . D HEAD
|
|---|
| 142 | . W !!,"REPORT SUMMARY:",!,"---------------"
|
|---|
| 143 | . F DGCAT=1,2,3 D
|
|---|
| 144 | .. S:DGCAT'=3 DGCNT(3)=$G(DGCNT(3))+$G(DGCNT(DGCAT))
|
|---|
| 145 | .. W:DGCAT=3 !?39,"-------"
|
|---|
| 146 | .. W !,"Total Assignments for Category "
|
|---|
| 147 | .. W $S(DGCAT=1:"I",DGCAT=2:"II",1:"I & II"),":"
|
|---|
| 148 | .. W ?40,$J(+$G(DGCNT(DGCAT)),6)
|
|---|
| 149 | ;
|
|---|
| 150 | W !!,"<End of Report>"
|
|---|
| 151 | Q
|
|---|
| 152 | ;
|
|---|
| 153 | PAUSE(DGQ) ; pause screen display
|
|---|
| 154 | ; Input:
|
|---|
| 155 | ; DGQ - var used to quit report processing to user CRT
|
|---|
| 156 | ; Output:
|
|---|
| 157 | ; DGQ - passed by reference - 0 = Continue, 1 = Quit
|
|---|
| 158 | ;
|
|---|
| 159 | I $G(DGPAGE)>0,$E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQ=1
|
|---|
| 160 | Q
|
|---|
| 161 | ;
|
|---|
| 162 | SUB(CNT,TYP) ; print sub-totals
|
|---|
| 163 | ; Input:
|
|---|
| 164 | ; CNT - count of records printed
|
|---|
| 165 | ; TYP - indicator of which total count is being printed
|
|---|
| 166 | ; Output: Write lines of Sub-Totals and Totals per Flag and Category
|
|---|
| 167 | ;
|
|---|
| 168 | N DGTYPE,DGCOUNT
|
|---|
| 169 | S DGTYPE=$S(TYP=1:"Flag",2:"Category "_$S(DGCAT=1:"I",1:"II"))
|
|---|
| 170 | S DGCOUNT=$S(TYP=1:CNT,1:DGCNT(DGCAT))
|
|---|
| 171 | W:TYP=1 !
|
|---|
| 172 | W !,"Total Assignments for "_DGTYPE_": ",DGCOUNT
|
|---|
| 173 | Q
|
|---|
| 174 | ;
|
|---|
| 175 | HEAD ;Print/Display page header
|
|---|
| 176 | I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
|
|---|
| 177 | D PAUSE(.DGQ)
|
|---|
| 178 | Q:DGQ
|
|---|
| 179 | W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF
|
|---|
| 180 | S DGPAGE=$G(DGPAGE)+1
|
|---|
| 181 | W !?25,"PATIENT RECORD FLAGS"
|
|---|
| 182 | W !?24,"FLAG ASSIGNMENT REPORT",?70,"Page: ",$G(DGPAGE)
|
|---|
| 183 | W !?24,"----------------------",?48,"Printed: ",DGDT
|
|---|
| 184 | W !?2,"CATEGORY: "_$S($G(DGCAT)=1:"Category I (National)",$G(DGCAT)=2:"Category II (Local)",1:"Both (Category I & II)")
|
|---|
| 185 | W !,"DATE RANGE: ",$$FDATE^VALM1($G(DGSORT("DGBEG")))_" TO "_$$FDATE^VALM1($G(DGSORT("DGEND")))
|
|---|
| 186 | W !?1,"FLAG NAME: ",$G(DGFG),!
|
|---|
| 187 | I DGGRAND W DGLINE Q
|
|---|
| 188 | W !,"PATIENT NAME",?22,"SSN",?33,"ASSIGNED",?43,"REVIEW DT",?53,"STATUS",?63,"OWNING SITE"
|
|---|
| 189 | W !,"--------------------",?22,"---------",?33,"--------",?43,"--------",?53,"--------",?63,"-----------------"
|
|---|
| 190 | Q
|
|---|
| 191 | ;
|
|---|
| 192 | EXIT ;
|
|---|
| 193 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 194 | K @DGLIST
|
|---|
| 195 | I '$D(ZTQUEUED) D
|
|---|
| 196 | . K %ZIS,POP
|
|---|
| 197 | . D ^%ZISC,HOME^%ZIS
|
|---|
| 198 | Q
|
|---|
