SDESPATFLAGS ;ALB/BWF,DJS,ANU - PATIENT FLAGS RPC ;MAR 20, 2023
;;5.3;Scheduling;**818,831,843,844**;DEC 1997;Build 12
;;Per VHA Directive 6402, this routine should not be modified
;
Q
; Reference to PATIENT in ICR #7029
; Reference to DGPFAPIU in ICR #4903
; Reference to PRF NATIONAL FLAG in ICR #7021
; Reference to LOCAL FLAG in ICR #7020
; Reference to Patient Flag Asignment in ICR #7022
;
; RPC: SDES GET PATIENT FLAGS
; INPUT:
; DFN - Patient IEN (required)
; SDEAS - EAS Tracking number (optional)
;
GETFLAGS(RES,DFN,SDEAS) ;
N PRFDATA,DFNERROR,DFNERRORS,FN,RESNUM,PRFCNT,FIEN,FPTR,PRFARRY,NARR,FDATA,PRF
S DFNERROR=$$VALIDATEDFN^SDESPATRPC(.DFNERRORS,DFN)
I DFNERROR S DFNERRORS("Flag",1)="" D BUILDJSON(.RES,.DFNERRORS) Q
;
S FN=26.13
S PRFARRY("FugitiveFelonFlag")=$S($$GET1^DIQ(2,DFN,1100.01,"I"):"YES",1:"NO")
I '$D(^DGPF(FN,"C",DFN)) S PRFARRY("Flag",1)="" D BUILDJSON(.RES,.PRFARRY) Q
S PRFCNT=0
D LIST^DIC(26.15,,,"E",,,,,,,"FDATA","ERR"),BUILD(.PRFARRY,.FDATA,26.15,.PRFCNT) K FDATA
D LIST^DIC(26.11,,,"E",,,,,,,"FDATA","ERR"),BUILD(.PRFARRY,.FDATA,26.11,.PRFCNT) K FDATA
I '$D(PRFARRY("Flag")) S PRFARRY("Flag",1)=""
D BUILDJSON(.RES,.PRFARRY)
Q
;
BUILD(PRFARRY,FDATA,FN,PRFCNT) ;
N RESNUM,FIEN,FPTR,PRFIEN,SDZ,SDFILE,SDX
S RESNUM=0
F S RESNUM=$O(FDATA("DILIST",2,RESNUM)) Q:'RESNUM D
.S FIEN=$G(FDATA("DILIST",2,RESNUM))
.S FPTR=FIEN_";"_$P($$ROOT^DILFD(FN),U,2)
.;ANU - BEGIN - Quit if Status in PRF Assignment file (#26.13) is inactive
.;Check for the patient and PRF in the PRF Assignment File. Quit if there is no match.
.I '$D(^DGPF(26.13,"C",DFN,FPTR)) Q
.; Get PRF Assignment Information
.S PRFIEN=0
.S PRFIEN=$O(^DGPF(26.13,"C",DFN,FPTR,0))
.I 'PRFIEN Q
.I '$$GET1^DIQ(26.13,PRFIEN_",",.03,"I") Q
.;Quit if Status in PRF National flag(#26.15)/PRG local flag(#26.11) file is inactive
.S SDX=$P($G(FPTR),";",1),SDFILE=$S($G(FPTR)["26.15":26.15,1:26.11)
.I 'SDX Q
.I '$$GET1^DIQ(SDFILE,SDX_",",.02,"I") Q
.;ANU - END
.K PRFDATA
.D GETINF^DGPFAPIH(DFN,FPTR,,,"PRFDATA") Q:'$D(PRFDATA)
.S PRFCNT=PRFCNT+1
.S PRFARRY("Flag",PRFCNT,"ApprovedBy")=$P($G(PRFDATA("HIST",1,"APPRVBY")),U,2)
.S PRFARRY("Flag",PRFCNT,"Name")=$P($G(PRFDATA("FLAG")),U,2)
.S PRFARRY("Flag",PRFCNT,"Type")=$P($G(PRFDATA("FLAGTYPE")),U,2)
.S PRFARRY("Flag",PRFCNT,"Category")=$P($G(PRFDATA("CATEGORY")),U)
.S PRFARRY("Flag",PRFCNT,"AssignedDate")=$$FMTISO^SDAMUTDT($P($G(PRFDATA("ASSIGNDT")),U,1))
.S PRFARRY("Flag",PRFCNT,"OwnerSiteID")=$P($G(PRFDATA("OWNER")),U)
.S PRFARRY("Flag",PRFCNT,"OwnerSiteName")=$P($G(PRFDATA("OWNER")),U,2)
.S PRFARRY("Flag",PRFCNT,"OriginatingSiteID")=$P($G(PRFDATA("ORIGSITE")),U)
.S PRFARRY("Flag",PRFCNT,"OriginatingSiteName")=$P($G(PRFDATA("ORIGSITE")),U,2)
.S PRFARRY("Flag",PRFCNT,"ReviewDate")=$$FMTISO^SDAMUTDT($P($G(PRFDATA("REVIEWDT")),U))
.S NARR=0 F S NARR=$O(PRFDATA("NARR",NARR)) Q:'NARR D
..S PRFARRY("Flag",PRFCNT,"Narrative",NARR)=$G(PRFDATA("NARR",NARR,0))
Q
BUILDJSON(APPTLISTJSON,APPTLISTARRAY) ;Convert data to JSON
N JSONERR
S JSONERR=""
D ENCODE^SDESJSON(.APPTLISTARRAY,.APPTLISTJSON,.JSONERR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESPATFLAGS 3198 printed Oct 16, 2024@18:57:52 Page 2
SDESPATFLAGS ;ALB/BWF,DJS,ANU - PATIENT FLAGS RPC ;MAR 20, 2023
+1 ;;5.3;Scheduling;**818,831,843,844**;DEC 1997;Build 12
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ; Reference to PATIENT in ICR #7029
+6 ; Reference to DGPFAPIU in ICR #4903
+7 ; Reference to PRF NATIONAL FLAG in ICR #7021
+8 ; Reference to LOCAL FLAG in ICR #7020
+9 ; Reference to Patient Flag Asignment in ICR #7022
+10 ;
+11 ; RPC: SDES GET PATIENT FLAGS
+12 ; INPUT:
+13 ; DFN - Patient IEN (required)
+14 ; SDEAS - EAS Tracking number (optional)
+15 ;
GETFLAGS(RES,DFN,SDEAS) ;
+1 NEW PRFDATA,DFNERROR,DFNERRORS,FN,RESNUM,PRFCNT,FIEN,FPTR,PRFARRY,NARR,FDATA,PRF
+2 SET DFNERROR=$$VALIDATEDFN^SDESPATRPC(.DFNERRORS,DFN)
+3 IF DFNERROR
SET DFNERRORS("Flag",1)=""
DO BUILDJSON(.RES,.DFNERRORS)
QUIT
+4 ;
+5 SET FN=26.13
+6 SET PRFARRY("FugitiveFelonFlag")=$SELECT($$GET1^DIQ(2,DFN,1100.01,"I"):"YES",1:"NO")
+7 IF '$DATA(^DGPF(FN,"C",DFN))
SET PRFARRY("Flag",1)=""
DO BUILDJSON(.RES,.PRFARRY)
QUIT
+8 SET PRFCNT=0
+9 DO LIST^DIC(26.15,,,"E",,,,,,,"FDATA","ERR")
DO BUILD(.PRFARRY,.FDATA,26.15,.PRFCNT)
KILL FDATA
+10 DO LIST^DIC(26.11,,,"E",,,,,,,"FDATA","ERR")
DO BUILD(.PRFARRY,.FDATA,26.11,.PRFCNT)
KILL FDATA
+11 IF '$DATA(PRFARRY("Flag"))
SET PRFARRY("Flag",1)=""
+12 DO BUILDJSON(.RES,.PRFARRY)
+13 QUIT
+14 ;
BUILD(PRFARRY,FDATA,FN,PRFCNT) ;
+1 NEW RESNUM,FIEN,FPTR,PRFIEN,SDZ,SDFILE,SDX
+2 SET RESNUM=0
+3 FOR
SET RESNUM=$ORDER(FDATA("DILIST",2,RESNUM))
if 'RESNUM
QUIT
Begin DoDot:1
+4 SET FIEN=$GET(FDATA("DILIST",2,RESNUM))
+5 SET FPTR=FIEN_";"_$PIECE($$ROOT^DILFD(FN),U,2)
+6 ;ANU - BEGIN - Quit if Status in PRF Assignment file (#26.13) is inactive
+7 ;Check for the patient and PRF in the PRF Assignment File. Quit if there is no match.
+8 IF '$DATA(^DGPF(26.13,"C",DFN,FPTR))
QUIT
+9 ; Get PRF Assignment Information
+10 SET PRFIEN=0
+11 SET PRFIEN=$ORDER(^DGPF(26.13,"C",DFN,FPTR,0))
+12 IF 'PRFIEN
QUIT
+13 IF '$$GET1^DIQ(26.13,PRFIEN_",",.03,"I")
QUIT
+14 ;Quit if Status in PRF National flag(#26.15)/PRG local flag(#26.11) file is inactive
+15 SET SDX=$PIECE($GET(FPTR),";",1)
SET SDFILE=$SELECT($GET(FPTR)["26.15":26.15,1:26.11)
+16 IF 'SDX
QUIT
+17 IF '$$GET1^DIQ(SDFILE,SDX_",",.02,"I")
QUIT
+18 ;ANU - END
+19 KILL PRFDATA
+20 DO GETINF^DGPFAPIH(DFN,FPTR,,,"PRFDATA")
if '$DATA(PRFDATA)
QUIT
+21 SET PRFCNT=PRFCNT+1
+22 SET PRFARRY("Flag",PRFCNT,"ApprovedBy")=$PIECE($GET(PRFDATA("HIST",1,"APPRVBY")),U,2)
+23 SET PRFARRY("Flag",PRFCNT,"Name")=$PIECE($GET(PRFDATA("FLAG")),U,2)
+24 SET PRFARRY("Flag",PRFCNT,"Type")=$PIECE($GET(PRFDATA("FLAGTYPE")),U,2)
+25 SET PRFARRY("Flag",PRFCNT,"Category")=$PIECE($GET(PRFDATA("CATEGORY")),U)
+26 SET PRFARRY("Flag",PRFCNT,"AssignedDate")=$$FMTISO^SDAMUTDT($PIECE($GET(PRFDATA("ASSIGNDT")),U,1))
+27 SET PRFARRY("Flag",PRFCNT,"OwnerSiteID")=$PIECE($GET(PRFDATA("OWNER")),U)
+28 SET PRFARRY("Flag",PRFCNT,"OwnerSiteName")=$PIECE($GET(PRFDATA("OWNER")),U,2)
+29 SET PRFARRY("Flag",PRFCNT,"OriginatingSiteID")=$PIECE($GET(PRFDATA("ORIGSITE")),U)
+30 SET PRFARRY("Flag",PRFCNT,"OriginatingSiteName")=$PIECE($GET(PRFDATA("ORIGSITE")),U,2)
+31 SET PRFARRY("Flag",PRFCNT,"ReviewDate")=$$FMTISO^SDAMUTDT($PIECE($GET(PRFDATA("REVIEWDT")),U))
+32 SET NARR=0
FOR
SET NARR=$ORDER(PRFDATA("NARR",NARR))
if 'NARR
QUIT
Begin DoDot:2
+33 SET PRFARRY("Flag",PRFCNT,"Narrative",NARR)=$GET(PRFDATA("NARR",NARR,0))
End DoDot:2
End DoDot:1
+34 QUIT
BUILDJSON(APPTLISTJSON,APPTLISTARRAY) ;Convert data to JSON
+1 NEW JSONERR
+2 SET JSONERR=""
+3 DO ENCODE^SDESJSON(.APPTLISTARRAY,.APPTLISTJSON,.JSONERR)
+4 QUIT
