VistA-FOIAVistA/r/REGISTRATION-DGQE-DG-DPT-GR.../DGPFAPI.m

209 lines
7.2 KiB
Mathematica

DGPFAPI ;ALB/RBS - PRF EXTERNAL API'S ; 7/26/06 9:22am
;;5.3;Registration;**425,554,699,650**;Aug 13, 1993;Build 3
;
Q ;no direct entry
;
GETACT(DGDFN,DGPRF) ;Retrieve all ACTIVE Patient record flag assignments
;The purpose of this API is to facilitate the retrieval of specific
;data that can be used for the displaying of or the reporting of
;only ACTIVE Patient Record Flag (PRF) Assignment information for
;a patient.
;
; Associated DBIA: #3860 - DGPF PATIENT RECORD FLAG
;
; Input:
; DGDFN - IEN of patient in the PATIENT (#2) file
; DGPRF - Closed Root array of return values
; [Optional-default DGPFAPI]
;
; Output:
; Function result - "0" = No Active record flags for the patient
; - "nn" = Total number of flags returned in array
; DGPRF() - Array, passed by closed root reference
; - Multiple subscripted array of Active flag information
; If the function call is successful, this array will
; contain each of the Active flag records.
; - Subscript field value = internal value^external value
; 2 piece string caret(^) delimited
; DGPFAPI() - Default array name if no name passed
;
; Subscript Field Name Field #/File #
; --------- ---------- --------------
; "APPRVBY" APPROVED BY (.05)/(#26.14)
; (Note: The .5 (POSTMASTER) internal field value
; triggers an output transform that converts the
; external value of "POSTMASTER" to "CHIEF OF STAFF".
; "ASSIGNDT" DATE/TIME (.02)/(#26.14)
; "REVIEWDT" REVIEW DATE (.06)/(#26.13)
; "FLAG" FLAG NAME (.02)/(#26.13)
; "FLAGTYPE" TYPE (.03)/(#26.11 or #26.15)
; "CATEGORY" National or Local Flag (#26.15) or (#26.11)
; "OWNER" OWNER SITE (.04)/(#26.13)
; "ORIGSITE" ORIGINATING SITE (.05)/(#26.13)
; "TIUTITLE" TIU PN TITLE (.07)/(#26.11) or (#26.15)
; "TIULINK" TIU PN LINK (.06)/(#26.14)
; "NARR" ASSIGNMENT NARRATIVE (1)/(#26.13)
; (word-processing, multiple nodes)
; The format is in a word-processing value that may
; contain multiple nodes of text. Each node of text
; will be less than 80 characters in length.
; The format is as follows:
; TARGET_ROOT(nn,"NARR",line#,0)=text
; where:
; nn = a unique number for each Flag
; line# = a unique number starting at 1 for each wp line
; of narrative text
; 0 = standard subscript format for the nodes of a
; FileMan Word Processing field
;
N DGPFTCNT ;return results, "0"=no flags, "nn"=number of flags
N DGPFIENS ;array of all active flag assignment IEN's
N DGPFIEN ;ien of record flag assignment in (#26.13) file
N DGPFA ;flag assignment array
N DGPFAH ;flag assignment history array
N DGPFLAG ;flag record array
N DGPFLAH ;last flag assignment history array
N DGCAT ;flag category
;
Q:'$G(DGDFN) 0 ;Quit, null parameter
Q:'$$GETALL^DGPFAA(DGDFN,.DGPFIENS,1) 0 ;Quit, no Active assign's
;
S DGPRF=$G(DGPRF)
I DGPRF']"" S DGPRF="DGPFAPI" ;setup default array name
;
K @DGPRF ;Kill/initialize work array
;
S (DGPFIEN,DGCAT)="",DGPFTCNT=0
;
; loop all returned Active Record Flag Assignment ien's
F S DGPFIEN=$O(DGPFIENS(DGPFIEN)) Q:DGPFIEN="" D
. K DGPFA,DGPFAH,DGPFLAG,DGPFLAH
. ;
. ; retrieve single assignment record fields
. Q:'$$GETASGN^DGPFAA(DGPFIEN,.DGPFA)
. ;
. ; no patient DFN match
. I DGDFN'=$P(DGPFA("DFN"),U) Q
. ;
. ; get initial assignment history
. Q:'$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGPFIEN),.DGPFAH)
. ;
. ; get last assignment history
. Q:'$$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGPFIEN),.DGPFLAH)
. ;
. ; get record flag record
. Q:'$$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U),.DGPFLAG)
. ;
. S DGPFTCNT=DGPFTCNT+1
. ;
. ; approved by user
. S @DGPRF@(DGPFTCNT,"APPRVBY")=$G(DGPFLAH("APPRVBY"))
. ;
. ; initial assignment date/time
. S @DGPRF@(DGPFTCNT,"ASSIGNDT")=$G(DGPFAH("ASSIGNDT"))
. ;
. ; next review due date
. S @DGPRF@(DGPFTCNT,"REVIEWDT")=$G(DGPFA("REVIEWDT"))
. ;
. ; record flag name
. S @DGPRF@(DGPFTCNT,"FLAG")=$G(DGPFA("FLAG"))
. ;
. ; record flag type
. S @DGPRF@(DGPFTCNT,"FLAGTYPE")=$G(DGPFLAG("TYPE"))
. ;
. ; category of flag - I (NATIONAL) or II (LOCAL)
. S DGCAT=$S($G(DGPFA("FLAG"))["26.15":"I (NATIONAL)",1:"II (LOCAL)")
. S @DGPRF@(DGPFTCNT,"CATEGORY")=DGCAT_U_DGCAT
. ;
. ; owner site
. S @DGPRF@(DGPFTCNT,"OWNER")=$G(DGPFA("OWNER"))_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("OWNER")),U))
. ;
. ; originating site
. S @DGPRF@(DGPFTCNT,"ORIGSITE")=$G(DGPFA("ORIGSITE"))_" "_$$FMTPRNT^DGPFUT1($P($G(DGPFA("ORIGSITE")),U))
. ;
. ; add TIU info when Owner Site is a local division
. I $$ISDIV^DGPFUT($P(DGPFA("OWNER"),U)) D
. . ;
. . ; flag associated TIU PN Title
. . S @DGPRF@(DGPFTCNT,"TIUTITLE")=$G(DGPFLAG("TIUTITLE"))
. . ;
. . ; assignment history TIU PN Link
. . S @DGPRF@(DGPFTCNT,"TIULINK")=$G(DGPFLAH("TIULINK"))
. ;
. ; narrative
. I '$D(DGPFA("NARR",1,0)) D Q ;should never happen - but -
. . S @DGPRF@(DGPFTCNT,"NARR",1,0)="No Narrative Text"
. ;
. M @DGPRF@(DGPFTCNT,"NARR")=DGPFA("NARR")
;
; Re-Sort Active flags by category & alpha flag name
I +$G(DGPFTCNT)>1 D
. I $$SORT^DGPFUT2(DGPRF) ;naked IF to just do resort
;
Q DGPFTCNT
;
PRFQRY(DGDFN) ;query a treating facility for patient record flag assignments
;This function queries a given patient's treating facility to retrieve
;all patient record flag assignments for the patient.
;
; Input:
; DGDFN - pointer to patient in PATIENT (#2) file
;
; Output:
; Function value - 1 on success, 0 on failure
;
N DGEVNT
N DGRSLT
;
S DGRSLT=0
S DGEVNT=$$FNDEVNT^DGPFHLL1(DGDFN)
I DGEVNT D
. ;
. ;must have INCOMPLETE status
. Q:'$$ISINCOMP^DGPFHLL1(DGEVNT)
. ;
. ;run query using mode defined in PRF HL7 QUERY STATUS (#3) field of
. ;PRF PARAMETERS (#26.18) file.
. S DGRSLT=$$SNDQRY^DGPFHLS(DGDFN,$$QRYON^DGPFPARM())
;
Q DGRSLT
;
DISPPRF(DGDFN) ;display active patient record flag assignments
;This procedure performs a lookup for active patient record flag
;assignments for a given patient and formats the assignment data for
;roll-and-scroll display.
;
; Input:
; DGDFN - pointer to patient in PATIENT (#2) file
;
; Output:
; none
;
Q:'$D(XQY0)
Q:$P(XQY0,U)="DGPF RECORD FLAG ASSIGNMENT"
;
;protect Kernel IO variables
N IOBM,IOBOFF,IOBON,IOEDEOP,IOINHI,IOINORM,IORC,IORVOFF,IORVON,IOIL
N IOSC,IOSGRO,IOSTBM,IOTM,IOUOFF,IOUON
;
;protect ListMan variables
N VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCC,VALMCNT,VALMCOFF,VALMCON
N VALMDDF,VALMDN,VALMEVL,VALMHDR,VALMIOXY,VALMKEY,VALMLFT,VALMLST
N VALMMENU,VALMPGE,VALMSGR,VALMUP,VALMWD
;
;protect Unwinder variables
N ORU,ORUDA,ORUER,ORUFD,ORUFG,ORUSB,ORUSQ,ORUSV,ORUT,ORUW,ORUX
N XQORM,DQ
;
; protect original Listman VALM DATA global
K ^TMP($J,"DGPFVALM DATA")
M ^TMP($J,"DGPFVALM DATA")=^TMP("VALM DATA",$J)
;
D DISPPRF^DGPFUT1(DGDFN)
;
; restore original Listman VALM DATA global
M ^TMP("VALM DATA",$J)=^TMP($J,"DGPFVALM DATA")
;
K ^TMP($J,"DGPFVALM DATA")
Q