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