DGPFAPIH ;ALB/SCK - PRF API'S FOR HIGH RISK MENTAL HEALTH ; Jan 21, 2011
;;5.3;Registration;**836**;Aug 13, 1993;Build 35
;;
;; Supports Integration Agreement #4903, Controlled subscription
;
Q ; No direct entry
;
GETINF(DGDFN,DGPRF,DGSTART,DGEND,DGARR) ;
;
; This API returns information from the Patient Record Flag files for the specified
; patient and PRF flag. A date range for when the flag as active is optional.
;
; Input:
; DGDFN - IEN from the PATIENT File (#2) {Required]
; DGPRF - Variable pointer to the either the PRF LOCAL FLAG File (#26.11) or to
; the PRF NATIONAL FLAG File (#26.15) [Required]
; DGSTART - Start date for to search in FM format [Optional]
; DGEND - End date for search in FM format [Optional]
; DGARR - Return array for data (Closed Root (local or global) array of return values) [Optional]
;
; Output:
; DGRSLT - 1: Successful
; 0: Unsuccessful
;
; DGARR("ASSIGNDT") - Date of initial assignment
; DGARR("CATEGORY") - National or Local flag category
; DGARR("FLAG") - Variable pointer to Local/National flag files and flag name
; DGARR("FLAGTYPE") - Type of flag usage
; DGARR("NARR",n,0) - Describes the purpose and instructions for the application of the flag.
; This is a word-processing field.
; DGARR("ORIGSITE") - Site that initially assigned this flag (Relevent to National flags only)
; DGARR("OWNER") - Site which currently "Owns" this flag (Relevant to National flags only)
; DGARR("TIUTITLE") - Pointer to the TIU Document Definition file (#8925.1)
; DGARR("HIST",n,"ACTION") - Record Action, set of codes.
; DGARR("HIST",n,"APPRVBY") - Pointer to NEW PERSON File (#200), person approving the flag assignment
; DGARR("HIST",n,"DATETIME") - Date/Time of Action
; DGARR("HIST",n,"REVIEWDT") - Date for next review of record flag assignment
; DGARR("HIST",n,"COMMENT",n,0) - Narrative for the record assignment action. This is a word-processing field.
; DGARR("HIST",n,"TIULINK") - Pointer to the TIU Document file (#8925)
;
N DGRSLT,DGRANGE,DGIEN,DGNAME,DGX,DGASGNDT,DGCAT,DG2614,DGERR,DGDATA
;
S DGDFN=+$G(DGDFN) I 'DGDFN Q 0
I '$$CHKDFN^DGPFAPIU(DGDFN,.DGNAME) Q 0
;
S DGPRF=$G(DGPRF) I 'DGPRF Q 0
;
S DGSTART=+$G(DGSTART),DGEND=+$G(DGEND)
I '$$CHKDATE^DGPFAPIU(DGSTART,DGEND,.DGRANGE) Q 0
;
S DGARR=$G(DGARR)
I DGARR']"" S DGARR="DGPFAPI1"
K @DGARR
;
; Check for the patient and PRF in the PRF Assignment File. Quit if there is no match.
I '$D(^DGPF(26.13,"C",DGDFN,DGPRF)) Q 0
;
; Get PRF Assignment Information
S DGIEN=$O(^DGPF(26.13,"C",DGDFN,DGPRF,0))
D GETS^DIQ(26.13,DGIEN,".02;.03;.04;.05;.06;1","IEZ","DGDATA")
;
; Collect PRF Assignment Histories
K ^TMP("DG2614",$J)
S DG2614=0
F S DG2614=$O(^DGPF(26.14,"B",DGIEN,DG2614)) Q:'DG2614 D
. S ^TMP("DG2614",$J,DG2614,"NODE0")=$G(^DGPF(26.14,DG2614,0))
;
; Check date range inclusion
I DGRANGE["S"&('$$ACTIVE^DGPFAPIU(DGIEN,.DGRANGE)) D
. S DGRSLT=0
E D
. D BLDMAIN(DGIEN,.DGDATA)
. D BLDHIST
. S DGRSLT=1
;
K ^TMP("DG2614",$J)
Q +$G(DGRSLT)
;
BLDMAIN(DGIEN,DGDATA) ; Build main return array
N DGFILE,DGTMP,DGASGNDT,DGX,DGCAT,DGFILE,DGERR
;
S DGASGNDT=$$ASGNDATE^DGPFAPIU(DGIEN)
S @DGARR@("ASSIGNDT")=DGASGNDT_"^"_$S(DGASGNDT>0:$$FMTE^XLFDT(DGASGNDT),1:0)
S DGX=DGIEN_","
S @DGARR@("FLAG")=DGPRF_"^"_DGDATA(26.13,DGX,.02,"E")
S @DGARR@("ORIGSITE")=DGDATA(26.13,DGX,.05,"I")_"^"_DGDATA(26.13,DGX,.05,"E")
S @DGARR@("OWNER")=DGDATA(26.13,DGX,.04,"I")_"^"_DGDATA(26.13,DGX,.04,"E")
S @DGARR@("REVIEWDT")=DGDATA(26.13,DGX,.06,"I")_"^"_DGDATA(26.13,DGX,.06,"E")
M @DGARR@("NARR")=DGDATA(26.13,DGX,1)
K @DGARR@("NARR","E"),@DGARR@("NARR","I")
;
S DGX=$P($G(DGPRF),";",1),DGFILE=$S(DGPRF["26.15":26.15,1:26.11)
D GETS^DIQ(DGFILE,DGX,".03;.07","IE","DGTMP","DGERR")
S @DGARR@("FLAGTYPE")=DGTMP(DGFILE,DGX_",",.03,"I")_"^"_DGTMP(DGFILE,DGX_",",.03,"E")
S @DGARR@("TIUTITLE")=DGTMP(DGFILE,DGX_",",.07,"I")_"^"_DGTMP(DGFILE,DGX_",",.07,"E")
S DGCAT=$S($G(DGPRF)["26.15":"I (NATIONAL)",1:"II (LOCAL)")
S @DGARR@("CATEGORY")=DGCAT_"^"_DGCAT
Q
;
BLDHIST ; Build History array
N DGX,DGNDX
;
S (DGX,DGNDX)=0
F S DGX=$O(^TMP("DG2614",$J,DGX)) Q:'DGX D
. S DGNDX=DGNDX+1
. S @DGARR@("HIST",DGNDX,"ACTION")=$P($G(^TMP("DG2614",$J,DGX,"NODE0")),U,3)_"^"_$$GET1^DIQ(26.14,DGX,.03)
. S @DGARR@("HIST",DGNDX,"APPRVBY")=$P($G(^TMP("DG2614",$J,DGX,"NODE0")),U,5)_"^"_$$GET1^DIQ(26.14,DGX,.05)
. S @DGARR@("HIST",DGNDX,"DATETIME")=$P($G(^TMP("DG2614",$J,DGX,"NODE0")),U,2)_"^"_$$GET1^DIQ(26.14,DGX,.02)
. S @DGARR@("HIST",DGNDX,"TIULINK")=$P($G(^TMP("DG2614",$J,DGX,"NODE0")),U,6)_"^"_$$GET1^DIQ(26.14,DGX,.06)
. M @DGARR@("HIST",DGNDX,"COMMENT")=^DGPF(26.14,DGX,1)
. K @DGARR@("HIST",DGNDX,"COMMENT",0)
. S @DGARR@("HIST",DGNDX,"TIULINK")=$P($G(^TMP("DG2614",$J,DGX,"NODE0")),U,6)_"^"_$$GET1^DIQ(26.14,DGX,.06)
;
Q
;
GETLST(DGPRF,DGSTART,DGEND,DGARR) ;
; This API returns a list of patients with specified Patient Record Flag assigned.
;
; Input:
; DGPRF - Variable pointer to the either the PRF LOCAL FLAG File (#26.11) or to
; the PRF NATIONAL FLAG File (#26.15) [Required]
; DGSTART - Start date for to search in FM format [Optional]
; DGEND - End date for search in FM format [Optional]
; DGARR - Return array for data (Closed Root (local or global) array of return values) [Optional]
;
; Output:
; DGRSLT - Number of veterans added to the list
; DGARR(DFN,0) - Patient Name^VPID^Date of initial assignment^National or Local flag category^flag name
; If a local variable is not specified, then the resulting list is returned in the following
; TMP Global: ^TMP("DGPRFLST",$J)
;
N DGRANGE,DGDFN,DGLINE
;
S DGPRF=$G(DGPRF) I 'DGPRF Q 0
;
S DGSTART=+$G(DGSTART),DGEND=+$G(DGEND)
I '$$CHKDATE^DGPFAPIU(DGSTART,DGEND,.DGRANGE) Q 0
;
S DGARR=$G(DGARR)
I DGARR']"" S DGARR="^TMP(""DGPRFLST"",$J)"
K @DGARR
;
S DGDFN=0
F S DGDFN=$O(^DGPF(26.13,"AFLAG",DGPRF,DGDFN)) Q:'DGDFN D
. S DGIEN=$O(^DGPF(26.13,"AFLAG",DGPRF,DGDFN,0))
. Q:'$$ACTIVE^DGPFAPIU(DGIEN,.DGRANGE)
. S DGLINE=$$GET1^DIQ(2,DGDFN,.01)_"^"_$$GETICN^MPIF001(DGDFN)_"^"_$$ASGNDATE^DGPFAPIU(DGIEN)
. S DGLINE=DGLINE_"^"_$S(DGPRF[26.11:"II (LOCAL)",1:"I (NATIONAL)")_"^"_$$GET1^DIQ($S(DGPRF[26.11:26.11,1:26.15),+DGPRF,.01)
. S @DGARR@(DGDFN,0)=DGLINE
. S DGRSLT=$G(DGRSLT)+1
;
Q +$G(DGRSLT)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFAPIH 6803 printed Sep 23, 2025@20:23:21 Page 2
DGPFAPIH ;ALB/SCK - PRF API'S FOR HIGH RISK MENTAL HEALTH ; Jan 21, 2011
+1 ;;5.3;Registration;**836**;Aug 13, 1993;Build 35
+2 ;;
+3 ;; Supports Integration Agreement #4903, Controlled subscription
+4 ;
+5 ; No direct entry
QUIT
+6 ;
GETINF(DGDFN,DGPRF,DGSTART,DGEND,DGARR) ;
+1 ;
+2 ; This API returns information from the Patient Record Flag files for the specified
+3 ; patient and PRF flag. A date range for when the flag as active is optional.
+4 ;
+5 ; Input:
+6 ; DGDFN - IEN from the PATIENT File (#2) {Required]
+7 ; DGPRF - Variable pointer to the either the PRF LOCAL FLAG File (#26.11) or to
+8 ; the PRF NATIONAL FLAG File (#26.15) [Required]
+9 ; DGSTART - Start date for to search in FM format [Optional]
+10 ; DGEND - End date for search in FM format [Optional]
+11 ; DGARR - Return array for data (Closed Root (local or global) array of return values) [Optional]
+12 ;
+13 ; Output:
+14 ; DGRSLT - 1: Successful
+15 ; 0: Unsuccessful
+16 ;
+17 ; DGARR("ASSIGNDT") - Date of initial assignment
+18 ; DGARR("CATEGORY") - National or Local flag category
+19 ; DGARR("FLAG") - Variable pointer to Local/National flag files and flag name
+20 ; DGARR("FLAGTYPE") - Type of flag usage
+21 ; DGARR("NARR",n,0) - Describes the purpose and instructions for the application of the flag.
+22 ; This is a word-processing field.
+23 ; DGARR("ORIGSITE") - Site that initially assigned this flag (Relevent to National flags only)
+24 ; DGARR("OWNER") - Site which currently "Owns" this flag (Relevant to National flags only)
+25 ; DGARR("TIUTITLE") - Pointer to the TIU Document Definition file (#8925.1)
+26 ; DGARR("HIST",n,"ACTION") - Record Action, set of codes.
+27 ; DGARR("HIST",n,"APPRVBY") - Pointer to NEW PERSON File (#200), person approving the flag assignment
+28 ; DGARR("HIST",n,"DATETIME") - Date/Time of Action
+29 ; DGARR("HIST",n,"REVIEWDT") - Date for next review of record flag assignment
+30 ; DGARR("HIST",n,"COMMENT",n,0) - Narrative for the record assignment action. This is a word-processing field.
+31 ; DGARR("HIST",n,"TIULINK") - Pointer to the TIU Document file (#8925)
+32 ;
+33 NEW DGRSLT,DGRANGE,DGIEN,DGNAME,DGX,DGASGNDT,DGCAT,DG2614,DGERR,DGDATA
+34 ;
+35 SET DGDFN=+$GET(DGDFN)
IF 'DGDFN
QUIT 0
+36 IF '$$CHKDFN^DGPFAPIU(DGDFN,.DGNAME)
QUIT 0
+37 ;
+38 SET DGPRF=$GET(DGPRF)
IF 'DGPRF
QUIT 0
+39 ;
+40 SET DGSTART=+$GET(DGSTART)
SET DGEND=+$GET(DGEND)
+41 IF '$$CHKDATE^DGPFAPIU(DGSTART,DGEND,.DGRANGE)
QUIT 0
+42 ;
+43 SET DGARR=$GET(DGARR)
+44 IF DGARR']""
SET DGARR="DGPFAPI1"
+45 KILL @DGARR
+46 ;
+47 ; Check for the patient and PRF in the PRF Assignment File. Quit if there is no match.
+48 IF '$DATA(^DGPF(26.13,"C",DGDFN,DGPRF))
QUIT 0
+49 ;
+50 ; Get PRF Assignment Information
+51 SET DGIEN=$ORDER(^DGPF(26.13,"C",DGDFN,DGPRF,0))
+52 DO GETS^DIQ(26.13,DGIEN,".02;.03;.04;.05;.06;1","IEZ","DGDATA")
+53 ;
+54 ; Collect PRF Assignment Histories
+55 KILL ^TMP("DG2614",$JOB)
+56 SET DG2614=0
+57 FOR
SET DG2614=$ORDER(^DGPF(26.14,"B",DGIEN,DG2614))
if 'DG2614
QUIT
Begin DoDot:1
+58 SET ^TMP("DG2614",$JOB,DG2614,"NODE0")=$GET(^DGPF(26.14,DG2614,0))
End DoDot:1
+59 ;
+60 ; Check date range inclusion
+61 IF DGRANGE["S"&('$$ACTIVE^DGPFAPIU(DGIEN,.DGRANGE))
Begin DoDot:1
+62 SET DGRSLT=0
End DoDot:1
+63 IF '$TEST
Begin DoDot:1
+64 DO BLDMAIN(DGIEN,.DGDATA)
+65 DO BLDHIST
+66 SET DGRSLT=1
End DoDot:1
+67 ;
+68 KILL ^TMP("DG2614",$JOB)
+69 QUIT +$GET(DGRSLT)
+70 ;
BLDMAIN(DGIEN,DGDATA) ; Build main return array
+1 NEW DGFILE,DGTMP,DGASGNDT,DGX,DGCAT,DGFILE,DGERR
+2 ;
+3 SET DGASGNDT=$$ASGNDATE^DGPFAPIU(DGIEN)
+4 SET @DGARR@("ASSIGNDT")=DGASGNDT_"^"_$SELECT(DGASGNDT>0:$$FMTE^XLFDT(DGASGNDT),1:0)
+5 SET DGX=DGIEN_","
+6 SET @DGARR@("FLAG")=DGPRF_"^"_DGDATA(26.13,DGX,.02,"E")
+7 SET @DGARR@("ORIGSITE")=DGDATA(26.13,DGX,.05,"I")_"^"_DGDATA(26.13,DGX,.05,"E")
+8 SET @DGARR@("OWNER")=DGDATA(26.13,DGX,.04,"I")_"^"_DGDATA(26.13,DGX,.04,"E")
+9 SET @DGARR@("REVIEWDT")=DGDATA(26.13,DGX,.06,"I")_"^"_DGDATA(26.13,DGX,.06,"E")
+10 MERGE @DGARR@("NARR")=DGDATA(26.13,DGX,1)
+11 KILL @DGARR@("NARR","E"),@DGARR@("NARR","I")
+12 ;
+13 SET DGX=$PIECE($GET(DGPRF),";",1)
SET DGFILE=$SELECT(DGPRF["26.15":26.15,1:26.11)
+14 DO GETS^DIQ(DGFILE,DGX,".03;.07","IE","DGTMP","DGERR")
+15 SET @DGARR@("FLAGTYPE")=DGTMP(DGFILE,DGX_",",.03,"I")_"^"_DGTMP(DGFILE,DGX_",",.03,"E")
+16 SET @DGARR@("TIUTITLE")=DGTMP(DGFILE,DGX_",",.07,"I")_"^"_DGTMP(DGFILE,DGX_",",.07,"E")
+17 SET DGCAT=$SELECT($GET(DGPRF)["26.15":"I (NATIONAL)",1:"II (LOCAL)")
+18 SET @DGARR@("CATEGORY")=DGCAT_"^"_DGCAT
+19 QUIT
+20 ;
BLDHIST ; Build History array
+1 NEW DGX,DGNDX
+2 ;
+3 SET (DGX,DGNDX)=0
+4 FOR
SET DGX=$ORDER(^TMP("DG2614",$JOB,DGX))
if 'DGX
QUIT
Begin DoDot:1
+5 SET DGNDX=DGNDX+1
+6 SET @DGARR@("HIST",DGNDX,"ACTION")=$PIECE($GET(^TMP("DG2614",$JOB,DGX,"NODE0")),U,3)_"^"_$$GET1^DIQ(26.14,DGX,.03)
+7 SET @DGARR@("HIST",DGNDX,"APPRVBY")=$PIECE($GET(^TMP("DG2614",$JOB,DGX,"NODE0")),U,5)_"^"_$$GET1^DIQ(26.14,DGX,.05)
+8 SET @DGARR@("HIST",DGNDX,"DATETIME")=$PIECE($GET(^TMP("DG2614",$JOB,DGX,"NODE0")),U,2)_"^"_$$GET1^DIQ(26.14,DGX,.02)
+9 SET @DGARR@("HIST",DGNDX,"TIULINK")=$PIECE($GET(^TMP("DG2614",$JOB,DGX,"NODE0")),U,6)_"^"_$$GET1^DIQ(26.14,DGX,.06)
+10 MERGE @DGARR@("HIST",DGNDX,"COMMENT")=^DGPF(26.14,DGX,1)
+11 KILL @DGARR@("HIST",DGNDX,"COMMENT",0)
+12 SET @DGARR@("HIST",DGNDX,"TIULINK")=$PIECE($GET(^TMP("DG2614",$JOB,DGX,"NODE0")),U,6)_"^"_$$GET1^DIQ(26.14,DGX,.06)
End DoDot:1
+13 ;
+14 QUIT
+15 ;
GETLST(DGPRF,DGSTART,DGEND,DGARR) ;
+1 ; This API returns a list of patients with specified Patient Record Flag assigned.
+2 ;
+3 ; Input:
+4 ; DGPRF - Variable pointer to the either the PRF LOCAL FLAG File (#26.11) or to
+5 ; the PRF NATIONAL FLAG File (#26.15) [Required]
+6 ; DGSTART - Start date for to search in FM format [Optional]
+7 ; DGEND - End date for search in FM format [Optional]
+8 ; DGARR - Return array for data (Closed Root (local or global) array of return values) [Optional]
+9 ;
+10 ; Output:
+11 ; DGRSLT - Number of veterans added to the list
+12 ; DGARR(DFN,0) - Patient Name^VPID^Date of initial assignment^National or Local flag category^flag name
+13 ; If a local variable is not specified, then the resulting list is returned in the following
+14 ; TMP Global: ^TMP("DGPRFLST",$J)
+15 ;
+16 NEW DGRANGE,DGDFN,DGLINE
+17 ;
+18 SET DGPRF=$GET(DGPRF)
IF 'DGPRF
QUIT 0
+19 ;
+20 SET DGSTART=+$GET(DGSTART)
SET DGEND=+$GET(DGEND)
+21 IF '$$CHKDATE^DGPFAPIU(DGSTART,DGEND,.DGRANGE)
QUIT 0
+22 ;
+23 SET DGARR=$GET(DGARR)
+24 IF DGARR']""
SET DGARR="^TMP(""DGPRFLST"",$J)"
+25 KILL @DGARR
+26 ;
+27 SET DGDFN=0
+28 FOR
SET DGDFN=$ORDER(^DGPF(26.13,"AFLAG",DGPRF,DGDFN))
if 'DGDFN
QUIT
Begin DoDot:1
+29 SET DGIEN=$ORDER(^DGPF(26.13,"AFLAG",DGPRF,DGDFN,0))
+30 if '$$ACTIVE^DGPFAPIU(DGIEN,.DGRANGE)
QUIT
+31 SET DGLINE=$$GET1^DIQ(2,DGDFN,.01)_"^"_$$GETICN^MPIF001(DGDFN)_"^"_$$ASGNDATE^DGPFAPIU(DGIEN)
+32 SET DGLINE=DGLINE_"^"_$SELECT(DGPRF[26.11:"II (LOCAL)",1:"I (NATIONAL)")_"^"_$$GET1^DIQ($SELECT(DGPRF[26.11:26.11,1:26.15),+DGPRF,.01)
+33 SET @DGARR@(DGDFN,0)=DGLINE
+34 SET DGRSLT=$GET(DGRSLT)+1
End DoDot:1
+35 ;
+36 QUIT +$GET(DGRSLT)
