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

SDESPATFLAGS.m

Go to the documentation of this file. 
  1. SDESPATFLAGS ;ALB/BWF,DJS,ANU - PATIENT FLAGS RPC ;MAR 20, 2023
  1.  ;;5.3;Scheduling;**818,831,843,844**;DEC 1997;Build 12
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  Q
  1.  ; Reference to PATIENT in ICR #7029
  1.  ; Reference to DGPFAPIU in ICR #4903
  1.  ; Reference to PRF NATIONAL FLAG in ICR #7021
  1.  ; Reference to LOCAL FLAG in ICR #7020
  1.  ; Reference to Patient Flag Asignment in ICR #7022
  1.  ;
  1.  ; RPC: SDES GET PATIENT FLAGS
  1.  ; INPUT:
  1.  ;       DFN - Patient IEN (required)
  1.  ;       SDEAS - EAS Tracking number (optional)
  1.  ;
  1. GETFLAGS(RES,DFN,SDEAS) ;
  1.  N PRFDATA,DFNERROR,DFNERRORS,FN,RESNUM,PRFCNT,FIEN,FPTR,PRFARRY,NARR,FDATA,PRF
  1.  S DFNERROR=$$VALIDATEDFN^SDESPATRPC(.DFNERRORS,DFN)
  1.  I DFNERROR S DFNERRORS("Flag",1)="" D BUILDJSON(.RES,.DFNERRORS) Q
  1.  ;
  1.  S FN=26.13
  1.  S PRFARRY("FugitiveFelonFlag")=$S($$GET1^DIQ(2,DFN,1100.01,"I"):"YES",1:"NO")
  1.  I '$D(^DGPF(FN,"C",DFN)) S PRFARRY("Flag",1)="" D BUILDJSON(.RES,.PRFARRY) Q
  1.  S PRFCNT=0
  1.  D LIST^DIC(26.15,,,"E",,,,,,,"FDATA","ERR"),BUILD(.PRFARRY,.FDATA,26.15,.PRFCNT) K FDATA
  1.  D LIST^DIC(26.11,,,"E",,,,,,,"FDATA","ERR"),BUILD(.PRFARRY,.FDATA,26.11,.PRFCNT) K FDATA
  1.  I '$D(PRFARRY("Flag")) S PRFARRY("Flag",1)=""
  1.  D BUILDJSON(.RES,.PRFARRY)
  1.  Q
  1.  ;
  1. BUILD(PRFARRY,FDATA,FN,PRFCNT) ;
  1.  N RESNUM,FIEN,FPTR,PRFIEN,SDZ,SDFILE,SDX
  1.  S RESNUM=0
  1.  F  S RESNUM=$O(FDATA("DILIST",2,RESNUM)) Q:'RESNUM  D
  1.  .S FIEN=$G(FDATA("DILIST",2,RESNUM))
  1.  .S FPTR=FIEN_";"_$P($$ROOT^DILFD(FN),U,2)
  1.  .;ANU - BEGIN - Quit if Status in PRF Assignment file (#26.13) is inactive
  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",DFN,FPTR)) Q
  1.  .; Get PRF Assignment Information
  1.  .S PRFIEN=0
  1.  .S PRFIEN=$O(^DGPF(26.13,"C",DFN,FPTR,0))
  1.  .I 'PRFIEN Q
  1.  .I '$$GET1^DIQ(26.13,PRFIEN_",",.03,"I") Q
  1.  .;Quit if Status in PRF National flag(#26.15)/PRG local flag(#26.11) file is inactive
  1.  .S SDX=$P($G(FPTR),";",1),SDFILE=$S($G(FPTR)["26.15":26.15,1:26.11)
  1.  .I 'SDX Q
  1.  .I '$$GET1^DIQ(SDFILE,SDX_",",.02,"I") Q
  1.  .;ANU - END
  1.  .K PRFDATA
  1.  .D GETINF^DGPFAPIH(DFN,FPTR,,,"PRFDATA") Q:'$D(PRFDATA)
  1.  .S PRFCNT=PRFCNT+1
  1.  .S PRFARRY("Flag",PRFCNT,"ApprovedBy")=$P($G(PRFDATA("HIST",1,"APPRVBY")),U,2)
  1.  .S PRFARRY("Flag",PRFCNT,"Name")=$P($G(PRFDATA("FLAG")),U,2)
  1.  .S PRFARRY("Flag",PRFCNT,"Type")=$P($G(PRFDATA("FLAGTYPE")),U,2)
  1.  .S PRFARRY("Flag",PRFCNT,"Category")=$P($G(PRFDATA("CATEGORY")),U)
  1.  .S PRFARRY("Flag",PRFCNT,"AssignedDate")=$$FMTISO^SDAMUTDT($P($G(PRFDATA("ASSIGNDT")),U,1))
  1.  .S PRFARRY("Flag",PRFCNT,"OwnerSiteID")=$P($G(PRFDATA("OWNER")),U)
  1.  .S PRFARRY("Flag",PRFCNT,"OwnerSiteName")=$P($G(PRFDATA("OWNER")),U,2)
  1.  .S PRFARRY("Flag",PRFCNT,"OriginatingSiteID")=$P($G(PRFDATA("ORIGSITE")),U)
  1.  .S PRFARRY("Flag",PRFCNT,"OriginatingSiteName")=$P($G(PRFDATA("ORIGSITE")),U,2)
  1.  .S PRFARRY("Flag",PRFCNT,"ReviewDate")=$$FMTISO^SDAMUTDT($P($G(PRFDATA("REVIEWDT")),U))
  1.  .S NARR=0 F  S NARR=$O(PRFDATA("NARR",NARR)) Q:'NARR  D
  1.  ..S PRFARRY("Flag",PRFCNT,"Narrative",NARR)=$G(PRFDATA("NARR",NARR,0))
  1.  Q
  1. BUILDJSON(APPTLISTJSON,APPTLISTARRAY) ;Convert data to JSON
  1.  N JSONERR
  1.  S JSONERR=""
  1.  D ENCODE^SDESJSON(.APPTLISTARRAY,.APPTLISTJSON,.JSONERR)
  1.  Q