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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFAPI 7631 printed Sep 23, 2025@20:23:18 Page 2
DGPFAPI ;ALB/RBS - PRF EXTERNAL API'S ; 7/26/06 9:22am
+1 ;;5.3;Registration;**425,554,699,650**;Aug 13, 1993;Build 3
+2 ;
+3 ;no direct entry
QUIT
+4 ;
GETACT(DGDFN,DGPRF) ;Retrieve all ACTIVE Patient record flag assignments
+1 ;The purpose of this API is to facilitate the retrieval of specific
+2 ;data that can be used for the displaying of or the reporting of
+3 ;only ACTIVE Patient Record Flag (PRF) Assignment information for
+4 ;a patient.
+5 ;
+6 ; Associated DBIA: #3860 - DGPF PATIENT RECORD FLAG
+7 ;
+8 ; Input:
+9 ; DGDFN - IEN of patient in the PATIENT (#2) file
+10 ; DGPRF - Closed Root array of return values
+11 ; [Optional-default DGPFAPI]
+12 ;
+13 ; Output:
+14 ; Function result - "0" = No Active record flags for the patient
+15 ; - "nn" = Total number of flags returned in array
+16 ; DGPRF() - Array, passed by closed root reference
+17 ; - Multiple subscripted array of Active flag information
+18 ; If the function call is successful, this array will
+19 ; contain each of the Active flag records.
+20 ; - Subscript field value = internal value^external value
+21 ; 2 piece string caret(^) delimited
+22 ; DGPFAPI() - Default array name if no name passed
+23 ;
+24 ; Subscript Field Name Field #/File #
+25 ; --------- ---------- --------------
+26 ; "APPRVBY" APPROVED BY (.05)/(#26.14)
+27 ; (Note: The .5 (POSTMASTER) internal field value
+28 ; triggers an output transform that converts the
+29 ; external value of "POSTMASTER" to "CHIEF OF STAFF".
+30 ; "ASSIGNDT" DATE/TIME (.02)/(#26.14)
+31 ; "REVIEWDT" REVIEW DATE (.06)/(#26.13)
+32 ; "FLAG" FLAG NAME (.02)/(#26.13)
+33 ; "FLAGTYPE" TYPE (.03)/(#26.11 or #26.15)
+34 ; "CATEGORY" National or Local Flag (#26.15) or (#26.11)
+35 ; "OWNER" OWNER SITE (.04)/(#26.13)
+36 ; "ORIGSITE" ORIGINATING SITE (.05)/(#26.13)
+37 ; "TIUTITLE" TIU PN TITLE (.07)/(#26.11) or (#26.15)
+38 ; "TIULINK" TIU PN LINK (.06)/(#26.14)
+39 ; "NARR" ASSIGNMENT NARRATIVE (1)/(#26.13)
+40 ; (word-processing, multiple nodes)
+41 ; The format is in a word-processing value that may
+42 ; contain multiple nodes of text. Each node of text
+43 ; will be less than 80 characters in length.
+44 ; The format is as follows:
+45 ; TARGET_ROOT(nn,"NARR",line#,0)=text
+46 ; where:
+47 ; nn = a unique number for each Flag
+48 ; line# = a unique number starting at 1 for each wp line
+49 ; of narrative text
+50 ; 0 = standard subscript format for the nodes of a
+51 ; FileMan Word Processing field
+52 ;
+53 ;return results, "0"=no flags, "nn"=number of flags
NEW DGPFTCNT
+54 ;array of all active flag assignment IEN's
NEW DGPFIENS
+55 ;ien of record flag assignment in (#26.13) file
NEW DGPFIEN
+56 ;flag assignment array
NEW DGPFA
+57 ;flag assignment history array
NEW DGPFAH
+58 ;flag record array
NEW DGPFLAG
+59 ;last flag assignment history array
NEW DGPFLAH
+60 ;flag category
NEW DGCAT
+61 ;
+62 ;Quit, null parameter
if '$GET(DGDFN)
QUIT 0
+63 ;Quit, no Active assign's
if '$$GETALL^DGPFAA(DGDFN,.DGPFIENS,1)
QUIT 0
+64 ;
+65 SET DGPRF=$GET(DGPRF)
+66 ;setup default array name
IF DGPRF']""
SET DGPRF="DGPFAPI"
+67 ;
+68 ;Kill/initialize work array
KILL @DGPRF
+69 ;
+70 SET (DGPFIEN,DGCAT)=""
SET DGPFTCNT=0
+71 ;
+72 ; loop all returned Active Record Flag Assignment ien's
+73 FOR
SET DGPFIEN=$ORDER(DGPFIENS(DGPFIEN))
if DGPFIEN=""
QUIT
Begin DoDot:1
+74 KILL DGPFA,DGPFAH,DGPFLAG,DGPFLAH
+75 ;
+76 ; retrieve single assignment record fields
+77 if '$$GETASGN^DGPFAA(DGPFIEN,.DGPFA)
QUIT
+78 ;
+79 ; no patient DFN match
+80 IF DGDFN'=$PIECE(DGPFA("DFN"),U)
QUIT
+81 ;
+82 ; get initial assignment history
+83 if '$$GETHIST^DGPFAAH($$GETFIRST^DGPFAAH(DGPFIEN),.DGPFAH)
QUIT
+84 ;
+85 ; get last assignment history
+86 if '$$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGPFIEN),.DGPFLAH)
QUIT
+87 ;
+88 ; get record flag record
+89 if '$$GETFLAG^DGPFUT1($PIECE($GET(DGPFA("FLAG")),U),.DGPFLAG)
QUIT
+90 ;
+91 SET DGPFTCNT=DGPFTCNT+1
+92 ;
+93 ; approved by user
+94 SET @DGPRF@(DGPFTCNT,"APPRVBY")=$GET(DGPFLAH("APPRVBY"))
+95 ;
+96 ; initial assignment date/time
+97 SET @DGPRF@(DGPFTCNT,"ASSIGNDT")=$GET(DGPFAH("ASSIGNDT"))
+98 ;
+99 ; next review due date
+100 SET @DGPRF@(DGPFTCNT,"REVIEWDT")=$GET(DGPFA("REVIEWDT"))
+101 ;
+102 ; record flag name
+103 SET @DGPRF@(DGPFTCNT,"FLAG")=$GET(DGPFA("FLAG"))
+104 ;
+105 ; record flag type
+106 SET @DGPRF@(DGPFTCNT,"FLAGTYPE")=$GET(DGPFLAG("TYPE"))
+107 ;
+108 ; category of flag - I (NATIONAL) or II (LOCAL)
+109 SET DGCAT=$SELECT($GET(DGPFA("FLAG"))["26.15":"I (NATIONAL)",1:"II (LOCAL)")
+110 SET @DGPRF@(DGPFTCNT,"CATEGORY")=DGCAT_U_DGCAT
+111 ;
+112 ; owner site
+113 SET @DGPRF@(DGPFTCNT,"OWNER")=$GET(DGPFA("OWNER"))_" "_$$FMTPRNT^DGPFUT1($PIECE($GET(DGPFA("OWNER")),U))
+114 ;
+115 ; originating site
+116 SET @DGPRF@(DGPFTCNT,"ORIGSITE")=$GET(DGPFA("ORIGSITE"))_" "_$$FMTPRNT^DGPFUT1($PIECE($GET(DGPFA("ORIGSITE")),U))
+117 ;
+118 ; add TIU info when Owner Site is a local division
+119 IF $$ISDIV^DGPFUT($PIECE(DGPFA("OWNER"),U))
Begin DoDot:2
+120 ;
+121 ; flag associated TIU PN Title
+122 SET @DGPRF@(DGPFTCNT,"TIUTITLE")=$GET(DGPFLAG("TIUTITLE"))
+123 ;
+124 ; assignment history TIU PN Link
+125 SET @DGPRF@(DGPFTCNT,"TIULINK")=$GET(DGPFLAH("TIULINK"))
End DoDot:2
+126 ;
+127 ; narrative
+128 ;should never happen - but -
IF '$DATA(DGPFA("NARR",1,0))
Begin DoDot:2
+129 SET @DGPRF@(DGPFTCNT,"NARR",1,0)="No Narrative Text"
End DoDot:2
QUIT
+130 ;
+131 MERGE @DGPRF@(DGPFTCNT,"NARR")=DGPFA("NARR")
End DoDot:1
+132 ;
+133 ; Re-Sort Active flags by category & alpha flag name
+134 IF +$GET(DGPFTCNT)>1
Begin DoDot:1
+135 ;naked IF to just do resort
IF $$SORT^DGPFUT2(DGPRF)
End DoDot:1
+136 ;
+137 QUIT DGPFTCNT
+138 ;
PRFQRY(DGDFN) ;query a treating facility for patient record flag assignments
+1 ;This function queries a given patient's treating facility to retrieve
+2 ;all patient record flag assignments for the patient.
+3 ;
+4 ; Input:
+5 ; DGDFN - pointer to patient in PATIENT (#2) file
+6 ;
+7 ; Output:
+8 ; Function value - 1 on success, 0 on failure
+9 ;
+10 NEW DGEVNT
+11 NEW DGRSLT
+12 ;
+13 SET DGRSLT=0
+14 SET DGEVNT=$$FNDEVNT^DGPFHLL1(DGDFN)
+15 IF DGEVNT
Begin DoDot:1
+16 ;
+17 ;must have INCOMPLETE status
+18 if '$$ISINCOMP^DGPFHLL1(DGEVNT)
QUIT
+19 ;
+20 ;run query using mode defined in PRF HL7 QUERY STATUS (#3) field of
+21 ;PRF PARAMETERS (#26.18) file.
+22 SET DGRSLT=$$SNDQRY^DGPFHLS(DGDFN,$$QRYON^DGPFPARM())
End DoDot:1
+23 ;
+24 QUIT DGRSLT
+25 ;
DISPPRF(DGDFN) ;display active patient record flag assignments
+1 ;This procedure performs a lookup for active patient record flag
+2 ;assignments for a given patient and formats the assignment data for
+3 ;roll-and-scroll display.
+4 ;
+5 ; Input:
+6 ; DGDFN - pointer to patient in PATIENT (#2) file
+7 ;
+8 ; Output:
+9 ; none
+10 ;
+11 if '$DATA(XQY0)
QUIT
+12 if $PIECE(XQY0,U)="DGPF RECORD FLAG ASSIGNMENT"
QUIT
+13 ;
+14 ;protect Kernel IO variables
+15 NEW IOBM,IOBOFF,IOBON,IOEDEOP,IOINHI,IOINORM,IORC,IORVOFF,IORVON,IOIL
+16 NEW IOSC,IOSGRO,IOSTBM,IOTM,IOUOFF,IOUON
+17 ;
+18 ;protect ListMan variables
+19 NEW VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCC,VALMCNT,VALMCOFF,VALMCON
+20 NEW VALMDDF,VALMDN,VALMEVL,VALMHDR,VALMIOXY,VALMKEY,VALMLFT,VALMLST
+21 NEW VALMMENU,VALMPGE,VALMSGR,VALMUP,VALMWD
+22 ;
+23 ;protect Unwinder variables
+24 NEW ORU,ORUDA,ORUER,ORUFD,ORUFG,ORUSB,ORUSQ,ORUSV,ORUT,ORUW,ORUX
+25 NEW XQORM,DQ
+26 ;
+27 ; protect original Listman VALM DATA global
+28 KILL ^TMP($JOB,"DGPFVALM DATA")
+29 MERGE ^TMP($JOB,"DGPFVALM DATA")=^TMP("VALM DATA",$JOB)
+30 ;
+31 DO DISPPRF^DGPFUT1(DGDFN)
+32 ;
+33 ; restore original Listman VALM DATA global
+34 MERGE ^TMP("VALM DATA",$JOB)=^TMP($JOB,"DGPFVALM DATA")
+35 ;
+36 KILL ^TMP($JOB,"DGPFVALM DATA")
+37 QUIT
