Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPFAPIH

DGPFAPIH.m

Go to the documentation of this file. 
  1. DGPFAPIH ;ALB/SCK - PRF API'S FOR HIGH RISK MENTAL HEALTH ; Jan 21, 2011
  1.  ;;5.3;Registration;**836**;Aug 13, 1993;Build 35
  1.  ;;
  1.  ;; Supports Integration Agreement #4903, Controlled subscription
  1.  ;
  1.  Q  ; No direct entry
  1.  ;
  1. GETINF(DGDFN,DGPRF,DGSTART,DGEND,DGARR) ;
  1.  ;
  1.  ; This API returns information from the Patient Record Flag files for the specified
  1.  ; patient and PRF flag.  A date range for when the flag as active is optional.
  1.  ;
  1.  ; Input:
  1.  ;         DGDFN   - IEN from the PATIENT File (#2) {Required]
  1.  ;         DGPRF   - Variable pointer to the either the PRF LOCAL FLAG File (#26.11) or to
  1.  ;                    the PRF NATIONAL FLAG File (#26.15) [Required]
  1.  ;         DGSTART - Start date for to search in FM format [Optional]
  1.  ;         DGEND   - End date for search in FM format [Optional]
  1.  ;         DGARR   - Return array for data (Closed Root (local or global) array of return values) [Optional]
  1.  ;
  1.  ; Output:
  1.  ;         DGRSLT  - 1: Successful
  1.  ;                   0: Unsuccessful
  1.  ;
  1.  ;         DGARR("ASSIGNDT") - Date of initial assignment
  1.  ;         DGARR("CATEGORY") - National or Local flag category
  1.  ;         DGARR("FLAG")     - Variable pointer to Local/National flag files and flag name
  1.  ;         DGARR("FLAGTYPE") - Type of flag usage
  1.  ;         DGARR("NARR",n,0) - Describes the purpose and instructions for the application of the flag.
  1.  ;                              This is a word-processing field.
  1.  ;         DGARR("ORIGSITE") - Site that initially assigned this flag (Relevent to National flags only)
  1.  ;         DGARR("OWNER")    - Site which currently "Owns" this flag (Relevant to National flags only)
  1.  ;         DGARR("TIUTITLE") - Pointer to the TIU Document Definition file (#8925.1)
  1.  ;         DGARR("HIST",n,"ACTION")   - Record Action, set of codes.
  1.  ;         DGARR("HIST",n,"APPRVBY")  - Pointer to NEW PERSON File (#200), person approving the flag assignment
  1.  ;         DGARR("HIST",n,"DATETIME") - Date/Time of Action
  1.  ;         DGARR("HIST",n,"REVIEWDT") - Date for next review of record flag assignment
  1.  ;         DGARR("HIST",n,"COMMENT",n,0)  - Narrative for the record assignment action.  This is a word-processing field.
  1.  ;         DGARR("HIST",n,"TIULINK")  - Pointer to the TIU Document file (#8925)
  1.  ;
  1.  N DGRSLT,DGRANGE,DGIEN,DGNAME,DGX,DGASGNDT,DGCAT,DG2614,DGERR,DGDATA
  1.  ;
  1.  S DGDFN=+$G(DGDFN) I 'DGDFN  Q 0
  1.  I '$$CHKDFN^DGPFAPIU(DGDFN,.DGNAME) Q 0
  1.  ;
  1.  S DGPRF=$G(DGPRF) I 'DGPRF Q 0
  1.  ;
  1.  S DGSTART=+$G(DGSTART),DGEND=+$G(DGEND)
  1.  I '$$CHKDATE^DGPFAPIU(DGSTART,DGEND,.DGRANGE) Q 0
  1.  ;
  1.  S DGARR=$G(DGARR)
  1.  I DGARR']"" S DGARR="DGPFAPI1"
  1.  K @DGARR
  1.  ;
  1.  ; Check for the patient and PRF in the PRF Assignment File.  Quit if there is no match.
  1.  I '$D(^DGPF(26.13,"C",DGDFN,DGPRF)) Q 0
  1.  ;
  1.  ; Get PRF Assignment Information
  1.  S DGIEN=$O(^DGPF(26.13,"C",DGDFN,DGPRF,0))
  1.  D GETS^DIQ(26.13,DGIEN,".02;.03;.04;.05;.06;1","IEZ","DGDATA")
  1.  ;
  1.  ; Collect PRF Assignment Histories
  1.  K ^TMP("DG2614",$J)
  1.  S DG2614=0
  1.  F  S DG2614=$O(^DGPF(26.14,"B",DGIEN,DG2614)) Q:'DG2614  D
  1.  . S ^TMP("DG2614",$J,DG2614,"NODE0")=$G(^DGPF(26.14,DG2614,0))
  1.  ;
  1.  ; Check date range inclusion
  1.  I DGRANGE["S"&('$$ACTIVE^DGPFAPIU(DGIEN,.DGRANGE)) D
  1.  . S DGRSLT=0
  1.  E  D
  1.  . D BLDMAIN(DGIEN,.DGDATA)
  1.  . D BLDHIST
  1.  . S DGRSLT=1
  1.  ;
  1.  K ^TMP("DG2614",$J)
  1.  Q +$G(DGRSLT)
  1.  ;
  1. BLDMAIN(DGIEN,DGDATA) ; Build main return array
  1.  N DGFILE,DGTMP,DGASGNDT,DGX,DGCAT,DGFILE,DGERR
  1.  ;
  1.  S DGASGNDT=$$ASGNDATE^DGPFAPIU(DGIEN)
  1.  S @DGARR@("ASSIGNDT")=DGASGNDT_"^"_$S(DGASGNDT>0:$$FMTE^XLFDT(DGASGNDT),1:0)
  1.  S DGX=DGIEN_","
  1.  S @DGARR@("FLAG")=DGPRF_"^"_DGDATA(26.13,DGX,.02,"E")
  1.  S @DGARR@("ORIGSITE")=DGDATA(26.13,DGX,.05,"I")_"^"_DGDATA(26.13,DGX,.05,"E")
  1.  S @DGARR@("OWNER")=DGDATA(26.13,DGX,.04,"I")_"^"_DGDATA(26.13,DGX,.04,"E")
  1.  S @DGARR@("REVIEWDT")=DGDATA(26.13,DGX,.06,"I")_"^"_DGDATA(26.13,DGX,.06,"E")
  1.  M @DGARR@("NARR")=DGDATA(26.13,DGX,1)
  1.  K @DGARR@("NARR","E"),@DGARR@("NARR","I")
  1.  ;
  1.  S DGX=$P($G(DGPRF),";",1),DGFILE=$S(DGPRF["26.15":26.15,1:26.11)
  1.  D GETS^DIQ(DGFILE,DGX,".03;.07","IE","DGTMP","DGERR")
  1.  S @DGARR@("FLAGTYPE")=DGTMP(DGFILE,DGX_",",.03,"I")_"^"_DGTMP(DGFILE,DGX_",",.03,"E")
  1.  S @DGARR@("TIUTITLE")=DGTMP(DGFILE,DGX_",",.07,"I")_"^"_DGTMP(DGFILE,DGX_",",.07,"E")
  1.  S DGCAT=$S($G(DGPRF)["26.15":"I (NATIONAL)",1:"II (LOCAL)")
  1.  S @DGARR@("CATEGORY")=DGCAT_"^"_DGCAT
  1.  Q
  1.  ;
  1. BLDHIST ; Build History array
  1.  N DGX,DGNDX
  1.  ;
  1.  S (DGX,DGNDX)=0
  1.  F  S DGX=$O(^TMP("DG2614",$J,DGX)) Q:'DGX  D
  1.  . S DGNDX=DGNDX+1
  1.  . S @DGARR@("HIST",DGNDX,"ACTION")=$P($G(^TMP("DG2614",$J,DGX,"NODE0")),U,3)_"^"_$$GET1^DIQ(26.14,DGX,.03)
  1.  . S @DGARR@("HIST",DGNDX,"APPRVBY")=$P($G(^TMP("DG2614",$J,DGX,"NODE0")),U,5)_"^"_$$GET1^DIQ(26.14,DGX,.05)
  1.  . S @DGARR@("HIST",DGNDX,"DATETIME")=$P($G(^TMP("DG2614",$J,DGX,"NODE0")),U,2)_"^"_$$GET1^DIQ(26.14,DGX,.02)
  1.  . S @DGARR@("HIST",DGNDX,"TIULINK")=$P($G(^TMP("DG2614",$J,DGX,"NODE0")),U,6)_"^"_$$GET1^DIQ(26.14,DGX,.06)
  1.  . M @DGARR@("HIST",DGNDX,"COMMENT")=^DGPF(26.14,DGX,1)
  1.  . K @DGARR@("HIST",DGNDX,"COMMENT",0)
  1.  . S @DGARR@("HIST",DGNDX,"TIULINK")=$P($G(^TMP("DG2614",$J,DGX,"NODE0")),U,6)_"^"_$$GET1^DIQ(26.14,DGX,.06)
  1.  ;
  1.  Q
  1.  ;
  1. GETLST(DGPRF,DGSTART,DGEND,DGARR) ;
  1.  ; This API returns a list of patients with specified Patient Record Flag assigned.
  1.  ;
  1.  ; Input:
  1.  ;         DGPRF   - Variable pointer to the either the PRF LOCAL FLAG File (#26.11) or to
  1.  ;                    the PRF NATIONAL FLAG File (#26.15) [Required]
  1.  ;         DGSTART - Start date for to search in FM format [Optional]
  1.  ;         DGEND   - End date for search in FM format [Optional]
  1.  ;         DGARR   - Return array for data (Closed Root (local or global) array of return values) [Optional]
  1.  ;
  1.  ; Output:
  1.  ;         DGRSLT  - Number of veterans added to the list
  1.  ;         DGARR(DFN,0) - Patient Name^VPID^Date of initial assignment^National or Local flag category^flag name
  1.  ;                        If a local variable is not specified, then the resulting list is returned in the following
  1.  ;                        TMP Global:  ^TMP("DGPRFLST",$J)
  1.  ;
  1.  N DGRANGE,DGDFN,DGLINE
  1.  ;
  1.  S DGPRF=$G(DGPRF) I 'DGPRF Q 0
  1.  ;
  1.  S DGSTART=+$G(DGSTART),DGEND=+$G(DGEND)
  1.  I '$$CHKDATE^DGPFAPIU(DGSTART,DGEND,.DGRANGE) Q 0
  1.  ;
  1.  S DGARR=$G(DGARR)
  1.  I DGARR']"" S DGARR="^TMP(""DGPRFLST"",$J)"
  1.  K @DGARR
  1.  ;
  1.  S DGDFN=0
  1.  F  S DGDFN=$O(^DGPF(26.13,"AFLAG",DGPRF,DGDFN)) Q:'DGDFN  D
  1.  . S DGIEN=$O(^DGPF(26.13,"AFLAG",DGPRF,DGDFN,0))
  1.  . Q:'$$ACTIVE^DGPFAPIU(DGIEN,.DGRANGE)
  1.  . S DGLINE=$$GET1^DIQ(2,DGDFN,.01)_"^"_$$GETICN^MPIF001(DGDFN)_"^"_$$ASGNDATE^DGPFAPIU(DGIEN)
  1.  . 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)
  1.  . S @DGARR@(DGDFN,0)=DGLINE
  1.  . S DGRSLT=$G(DGRSLT)+1
  1.  ;
  1.  Q +$G(DGRSLT)