[613] | 1 | DGPFRAB1 ;ALB/RBS - PRF APPROVED BY REPORT CONT. ; 6/4/04 11:17am
|
---|
| 2 | ;;5.3;Registration;**554**;Aug 13, 1993
|
---|
| 3 | ;
|
---|
| 4 | ;This routine will be used to display or print all Patient Record
|
---|
| 5 | ;Flag Assignment History Actions for the Approved By Person who
|
---|
| 6 | ;authorized the new entry or edit of an assignment to the patient.
|
---|
| 7 | ;
|
---|
| 8 | ; Input: The following sort array contains the report parameters:
|
---|
| 9 | ; DGSORT("DGAPROV") = pointer to NEW PERSON (#200) file^Person Name
|
---|
| 10 | ; or
|
---|
| 11 | ; = "A" = All approved by persons
|
---|
| 12 | ; DGSORT("DGCAT") = CATEGORY
|
---|
| 13 | ; 1^Category I (National)
|
---|
| 14 | ; 2^Category II (Local)
|
---|
| 15 | ; 3^Both
|
---|
| 16 | ; DGSORT("DGSTATUS") = Assignment Status to report on
|
---|
| 17 | ; 1^Active
|
---|
| 18 | ; 2^Inactive
|
---|
| 19 | ; 3^Both
|
---|
| 20 | ; DGSORT("DGBEG") = BEGINNING DATE (internal FileMan date)
|
---|
| 21 | ; DGSORT("DGEND") = ENDING DATE (internal FileMan date)
|
---|
| 22 | ;
|
---|
| 23 | ; Output: A formatted report of the Approved By person's assignments
|
---|
| 24 | ; that they have authorized to be assigned to a patient.
|
---|
| 25 | ;
|
---|
| 26 | ;- no direct entry
|
---|
| 27 | QUIT
|
---|
| 28 | ;
|
---|
| 29 | START ; compile and print report
|
---|
| 30 | I $E(IOST)="C" D WAIT^DICD
|
---|
| 31 | N DGLIST ;temp global name used for report list
|
---|
| 32 | S DGLIST=$NA(^TMP("DGPFRAB1",$J))
|
---|
| 33 | K @DGLIST
|
---|
| 34 | D LOOP(.DGSORT,DGLIST)
|
---|
| 35 | D PRINT(.DGSORT,DGLIST)
|
---|
| 36 | K @DGLIST
|
---|
| 37 | D EXIT
|
---|
| 38 | Q
|
---|
| 39 | ;
|
---|
| 40 | LOOP(DGSORT,DGLIST) ;use sort var's for record searching to build list
|
---|
| 41 | ; Input:
|
---|
| 42 | ; DGSORT - array of user selected report parameters
|
---|
| 43 | ; DGLIST - temp global name
|
---|
| 44 | ;
|
---|
| 45 | ; Output:
|
---|
| 46 | ; ^TMP("DGPFRAB1",$J) - temp global containing report output
|
---|
| 47 | ;
|
---|
| 48 | N DGABIEN ;approved by person ien
|
---|
| 49 | N DGAIEN ;approved by history assignment ien
|
---|
| 50 | N DGAPROV ;approved by sort
|
---|
| 51 | N DGBEG ;sort beginning date
|
---|
| 52 | N DGC ;var used to check which category is being reported on
|
---|
| 53 | N DGCAT ;sort flag category
|
---|
| 54 | N DGCATG ;category 1 or 2
|
---|
| 55 | N DGEND ;sort ending date
|
---|
| 56 | N DGHIEN ;history assignment ien
|
---|
| 57 | N DGPFA ;assignment data array
|
---|
| 58 | N DGPFAH ;assignment history data array
|
---|
| 59 | N DGQ ;quit var
|
---|
| 60 | N DGSTAT ;status of assignment
|
---|
| 61 | N DGSTATUS ;sort status
|
---|
| 62 | N DGSUB ;loop flag
|
---|
| 63 | N DGX ;loop var
|
---|
| 64 | ;
|
---|
| 65 | ; setup variables equal to user input parameter subscripts
|
---|
| 66 | ; "DGAPROV", "DGCAT", "DGSTATUS", "DGBEG", "DGEND"
|
---|
| 67 | S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX)
|
---|
| 68 | ;
|
---|
| 69 | S DGABIEN=+DGAPROV ; if 0, then All Approved By sort
|
---|
| 70 | S DGC=$S(+DGCAT=3:0,1:+DGCAT) ; 0=Both categories sort
|
---|
| 71 | S:DGC DGC=$S(DGC=1:26.15,1:26.11) ; specific file
|
---|
| 72 | S DGSTAT=+DGSTATUS ; assignments status to report on
|
---|
| 73 | S:DGSTAT=2 DGSTAT=0 ; inactive status value is '0'
|
---|
| 74 | ;
|
---|
| 75 | ; seed var to start at user selected values
|
---|
| 76 | S (DGQ,DGSUB)=0
|
---|
| 77 | S DGSUB=DGBEG-1
|
---|
| 78 | ;
|
---|
| 79 | ; loop history assignment d/t & approve by x-ref file
|
---|
| 80 | F S DGSUB=$O(^DGPF(26.14,"D",DGSUB)) Q:DGSUB="" D Q:DGQ
|
---|
| 81 | . I DGSUB>(DGEND+.999999999) S DGQ=1 Q
|
---|
| 82 | . S DGAIEN=""
|
---|
| 83 | . S:DGABIEN DGAIEN=DGABIEN-1 ;seed var to start before selection
|
---|
| 84 | . F S DGAIEN=$O(^DGPF(26.14,"D",DGSUB,DGAIEN)) Q:DGAIEN="" D
|
---|
| 85 | .. I DGABIEN,(DGAIEN>DGABIEN) Q
|
---|
| 86 | .. S DGHIEN=""
|
---|
| 87 | .. F S DGHIEN=$O(^DGPF(26.14,"D",DGSUB,DGAIEN,DGHIEN)) Q:DGHIEN="" D
|
---|
| 88 | ...K DGPFAH
|
---|
| 89 | ...Q:'$$GETHIST^DGPFAAH(DGHIEN,.DGPFAH)
|
---|
| 90 | ...I DGABIEN,(+DGPFAH("APPRVBY")'=DGABIEN) Q
|
---|
| 91 | ...K DGPFA
|
---|
| 92 | ...Q:'$$GETASGN^DGPFAA(+DGPFAH("ASSIGN"),.DGPFA)
|
---|
| 93 | ...I DGC,DGPFA("FLAG")'[DGC Q ;not correct category
|
---|
| 94 | ...I DGSTAT'=3,+DGPFA("STATUS")'=DGSTAT Q ;not correct status
|
---|
| 95 | ...S DGCATG=$S(DGPFA("FLAG")[26.15:1,1:2)
|
---|
| 96 | ...D BLDTMP(.DGPFA,.DGPFAH,DGHIEN,DGCATG,DGLIST)
|
---|
| 97 | Q
|
---|
| 98 | ;
|
---|
| 99 | BLDTMP(DGPFA,DGPFAH,DGHIEN,DGCATG,DGLIST) ; list global builder
|
---|
| 100 | ; Input:
|
---|
| 101 | ; DGPFA - array of assignment record data
|
---|
| 102 | ; DGPFAH - array of assignment history record data
|
---|
| 103 | ; DGHIEN - ien to PRF ASSIGNMENT HISTORY (#26.14) file record
|
---|
| 104 | ; DGCATG - category of flag 1=National, 2=Local
|
---|
| 105 | ; DGLIST - temp global name used for report list
|
---|
| 106 | ;
|
---|
| 107 | ; Output:
|
---|
| 108 | ; ^TMP("DGPFRFA1",$J) - temp global containing report output
|
---|
| 109 | ;
|
---|
| 110 | N DG1,DG2 ;subscript var's
|
---|
| 111 | N DGACTDT ;initial entry date
|
---|
| 112 | N DGDFN ;pointer to patient being reported on
|
---|
| 113 | N DGFGNM ;flag name
|
---|
| 114 | N DGLINE ;report detail line
|
---|
| 115 | N DGPAT ;array of patient demographics
|
---|
| 116 | N DGPNM ;patient name
|
---|
| 117 | N DGREV ;review date
|
---|
| 118 | ;
|
---|
| 119 | ; get patient demographics
|
---|
| 120 | S DGDFN=$P(DGPFA("DFN"),U)
|
---|
| 121 | K DGPAT
|
---|
| 122 | Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPAT)
|
---|
| 123 | S DGPNM=DGPAT("NAME")
|
---|
| 124 | S:DGPNM']"" DGPNM="MISSING PATIENT NAME"
|
---|
| 125 | S DGFGNM=$P(DGPFA("FLAG"),U,2)
|
---|
| 126 | S:DGFGNM']"" DGFGNM="MISSING FLAG NAME"
|
---|
| 127 | S DGACTDT=$$FDATE^VALM1(+DGPFAH("ASSIGNDT"))
|
---|
| 128 | I +DGPFA("REVIEWDT") D
|
---|
| 129 | .S DGREV=$$FDATE^VALM1(+DGPFA("REVIEWDT"))
|
---|
| 130 | E S DGREV="N/A"
|
---|
| 131 | S DGLINE=DGPAT("SSN")_U_$P(DGPFAH("ACTION"),U,2)_U_DGACTDT_U_DGREV_U_$P(DGPFA("STATUS"),U,2)
|
---|
| 132 | ; setup subscripts -
|
---|
| 133 | ; - Approved By Name, IEN, Cat, Flag Name, Pat Name, DFN, History IEN
|
---|
| 134 | S DG1=$P(DGPFAH("APPRVBY"),U,2),DG2=$P(DGPFAH("APPRVBY"),U)
|
---|
| 135 | S @DGLIST@(DG1,DG2,DGCATG,DGFGNM,DGPNM,DGDFN,DGHIEN)=DGLINE
|
---|
| 136 | Q
|
---|
| 137 | ;
|
---|
| 138 | PRINT(DGSORT,DGLIST) ;output report
|
---|
| 139 | ; Input:
|
---|
| 140 | ; DGSORT - array of user selected report parameters
|
---|
| 141 | ; DGLIST - temp global name used for report list
|
---|
| 142 | ;
|
---|
| 143 | ; Output: Formatted report to user selected device
|
---|
| 144 | ;
|
---|
| 145 | N DGAPNM ;approved by name
|
---|
| 146 | N DGCAT ;flag category
|
---|
| 147 | N DGCNT ;counter of detail lines
|
---|
| 148 | N DGDFN ;ien of patient
|
---|
| 149 | N DGDT ;date time report printed
|
---|
| 150 | N DGFG ;flag name
|
---|
| 151 | N DGIEN ;approved by ien
|
---|
| 152 | N DGLINE ;string of hyphens (80) for report header format
|
---|
| 153 | N DGLN ;loop var
|
---|
| 154 | N DGNAM ;patient name
|
---|
| 155 | N DGOCAT ;category switch flag
|
---|
| 156 | N DGODFN ;loop var flag
|
---|
| 157 | N DGOFG ;name switch flag
|
---|
| 158 | N DGOIEN ;ien switch flag
|
---|
| 159 | N DGPAGE ;page counter
|
---|
| 160 | N DGQ ;quit flag
|
---|
| 161 | N DGSTR ;string of detail line to display
|
---|
| 162 | N X,Y
|
---|
| 163 | ;
|
---|
| 164 | S (DGCNT,DGQ,DGPAGE)=0,$P(DGLINE,"-",81)=""
|
---|
| 165 | S DGDT=$P($$FMTE^XLFDT($$NOW^XLFDT,"T"),":",1,2)
|
---|
| 166 | ;
|
---|
| 167 | I $O(@DGLIST@(""))="" D Q
|
---|
| 168 | . D HEAD
|
---|
| 169 | . W !!," >>> No Record Flag Assignments were found using the report criteria.",!
|
---|
| 170 | ;
|
---|
| 171 | ; loop and print report
|
---|
| 172 | S (DGIEN,DGOIEN,DGAPNM,DGCAT,DGOCAT,DGFG,DGOFG,DGNAM,DGDFN,DGODFN,DGLN,DGSTR)=""
|
---|
| 173 | D HEAD
|
---|
| 174 | F S DGAPNM=$O(@DGLIST@(DGAPNM)) Q:DGAPNM="" D Q:DGQ
|
---|
| 175 | . F S DGIEN=$O(@DGLIST@(DGAPNM,DGIEN)) Q:DGIEN="" D Q:DGQ
|
---|
| 176 | . . I $Y>(IOSL-8) D PAUSE(.DGQ) Q:DGQ D HEAD,HEAD1 S DGOIEN=DGIEN
|
---|
| 177 | . . I DGOIEN'=DGIEN S DGOIEN=DGIEN W:DGCNT ! D HEAD1
|
---|
| 178 | . . F S DGCAT=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT)) Q:DGCAT="" D Q:DGQ
|
---|
| 179 | . . . F S DGFG=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG)) Q:DGFG="" D Q:DGQ
|
---|
| 180 | . . . . I $Y>(IOSL-8) D PAUSE(.DGQ) Q:DGQ D HEAD,HEAD1,HEAD2 S DGOFG=DGFG
|
---|
| 181 | . . . . I DGOFG'=DGFG W:DGOFG]"" !! D HEAD2 S DGOFG=DGFG
|
---|
| 182 | . . . . ; print patient detail line
|
---|
| 183 | . . . . D PRNTPAT
|
---|
| 184 | . ; reset var's to pop header's
|
---|
| 185 | . S (DGOIEN,DGOCAT,DGOFG)=""
|
---|
| 186 | ;
|
---|
| 187 | ;Shutdown if stop task requested
|
---|
| 188 | I DGQ W:$D(ZTQUEUED) !!,"REPORT STOPPED AT USER REQUEST" Q
|
---|
| 189 | ;
|
---|
| 190 | W !!,"<End of Report>"
|
---|
| 191 | Q
|
---|
| 192 | ;
|
---|
| 193 | PRNTPAT ; loop and print all patients for flag
|
---|
| 194 | ;
|
---|
| 195 | S DGODFN=""
|
---|
| 196 | F S DGNAM=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM)) Q:DGNAM="" D Q:DGQ
|
---|
| 197 | . F S DGDFN=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM,DGDFN)) Q:DGDFN="" D Q:DGQ
|
---|
| 198 | . . F S DGLN=$O(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM,DGDFN,DGLN)) Q:DGLN="" D Q:DGQ
|
---|
| 199 | . . . I $Y>(IOSL-3) D PAUSE(.DGQ) Q:DGQ D HEAD,HEAD1,HEAD2 S DGODFN=""
|
---|
| 200 | . . . S DGSTR=$G(@DGLIST@(DGAPNM,DGIEN,DGCAT,DGFG,DGNAM,DGDFN,DGLN))
|
---|
| 201 | . . . W !
|
---|
| 202 | . . . I DGODFN'=DGDFN S DGODFN=DGDFN D ;only print name once
|
---|
| 203 | . . . . W $E(DGNAM,1,16),?18,$P(DGSTR,U)
|
---|
| 204 | . . . W ?30,$P(DGSTR,U,2),?48,$P(DGSTR,U,3),?60,$P(DGSTR,U,4),?71,$P(DGSTR,U,5)
|
---|
| 205 | . . . S DGCNT=DGCNT+1
|
---|
| 206 | Q
|
---|
| 207 | ;
|
---|
| 208 | PAUSE(DGQ) ; pause screen display
|
---|
| 209 | ; Input:
|
---|
| 210 | ; DGQ - var used to quit report processing to user CRT
|
---|
| 211 | ; Output:
|
---|
| 212 | ; DGQ - passed by reference - 0 = Continue, 1 = Quit
|
---|
| 213 | ;
|
---|
| 214 | I $G(DGPAGE)>0,$E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQ=1
|
---|
| 215 | Q
|
---|
| 216 | ;
|
---|
| 217 | HEAD ;Print/Display page header
|
---|
| 218 | ;
|
---|
| 219 | I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 Q
|
---|
| 220 | W:'($E(IOST,1,2)'="C-"&'DGPAGE) @IOF
|
---|
| 221 | ;
|
---|
| 222 | S DGPAGE=$G(DGPAGE)+1
|
---|
| 223 | W !?25,"PATIENT RECORD FLAGS"
|
---|
| 224 | W !?20,"ASSIGNMENTS APPROVED BY REPORT",?68,"Page: ",$G(DGPAGE)
|
---|
| 225 | W !,"Date Range: ",$$FDATE^VALM1(DGSORT("DGBEG"))_" to "_$$FDATE^VALM1(DGSORT("DGEND"))
|
---|
| 226 | W ?50,"Printed: ",DGDT
|
---|
| 227 | W !,DGLINE
|
---|
| 228 | Q
|
---|
| 229 | ;
|
---|
| 230 | HEAD1 W !!,"Approved By: ",DGAPNM
|
---|
| 231 | Q
|
---|
| 232 | ;
|
---|
| 233 | HEAD2 W !,"Flag Name: ",$G(DGFG)," - ",$S(+DGCAT=1:"Category I (National)",1:"Category II (Local)")
|
---|
| 234 | ;
|
---|
| 235 | W !!,"PATIENT",?18,"SSN",?30,"ACTION",?48,"ACTION DT",?60,"REVIEW DT",?71,"STATUS"
|
---|
| 236 | W !,"================",?18,"==========",?30,"================",?48,"=========",?60,"=========",?71,"========="
|
---|
| 237 | Q
|
---|
| 238 | ;
|
---|
| 239 | EXIT ;
|
---|
| 240 | I $D(ZTQUEUED) S ZTREQ="@"
|
---|
| 241 | I '$D(ZTQUEUED) D
|
---|
| 242 | . K %ZIS,POP
|
---|
| 243 | . D ^%ZISC,HOME^%ZIS
|
---|
| 244 | Q
|
---|