SDESPATIENTDATA2 ;ALB/LAB,RRM - VISTA Patient data version 2; JUL 29, 2022@15:22
;;5.3;Scheduling;**823,824,827**;Aug 13, 1993;Build 10
;;Per VHA Directive 6402, this routine should not be modified
;
Q
; Documented API's and Integration Agreements
; -------------------------------------------
; Reference to ^DPT( In ICRs #7030,7029,1476,10035
;
; The intention of this rtn is to return a unique set of data from the Patient
;File (2) for a specifc IEN.
;
; It is assumed by getting here all business logic and validation has been performed.
;
; This routine should only be used for retrieving data from the Patient file.
Q
PATIENTIDADDDON(RETURN,DFN) ;
;Returns a basic set of data for a specific appointment
;
; Input
; IEN - Specific appointment IEN
; Return
; APPTDATA - Array of field names and the data for the field based on the IEN
;
N FN,IENS,PATDATA,SDMSG,INSRETURN,FUGRET,SENSRET,LOCRET,REGIEN,DATEEDITED,FUGRETIEN,LOCALFLAGIEN,COUNT
K RETURN
S FN=2,IENS=DFN_","
D GETS^DIQ(FN,DFN,".01;.02;.03;.09;.361","IE","PATDATA","SDMSG")
S RETURN("DFN")=DFN
S RETURN("ICN")=$$GETPATICN^SDESINPUTVALUTL(DFN) ;VSE-3648
S RETURN("Name")=$G(PATDATA(FN,IENS,.01,"E"))
S RETURN("Gender")=$G(PATDATA(FN,IENS,.02,"E"))
S RETURN("DOBI")=$G(PATDATA(FN,IENS,.03,"I"))
;S RETURN("DOBE")=$G(PATDATA(FN,IENS,.03,"E")) - vse 2097 - DG*5.3*804
S RETURN("DOBE")=$$FMTGMT^SDAMUTDT($G(PATDATA(FN,IENS,.03,"I")))
S RETURN("SSN")=$$LAST4SSN^SDESINPUTVALUTL(DFN)
S RETURN("EligibilityE")=$G(PATDATA(FN,IENS,.361,"E"))
S RETURN("EligibilityI")=$G(PATDATA(FN,IENS,.361,"I"))
; insurance
D INSURVERIFYREQ^SDESPATRPC(.INSRETURN,DFN)
S RETURN("InsuranceVerification")=$G(INSRETURN(1))
; sensitive record
D PTSEC^DGSEC4(.SENSRET,DFN)
S RETURN("SensitiveRecord")=$G(SENSRET(1))
; registration
I $D(^DGS(41.41,"B",DFN)) D
.S REGIEN=0
.S REGIEN=$O(^DGS(41.41,"B",DFN,REGIEN))
.S DATEEDITED=$$FMTISO^SDAMUTDT($$GET1^DIQ(41.41,REGIEN,1,"I"))
S RETURN("RegistrationEditDate")=$G(DATEEDITED)
; fugitive national flag
N PRFDATA,DFNERROR,DFNERRORS,FN,RESNUM,PRFCNT,FIEN,FPTR,PRFARRY,NARR,FDATA
S FN=26.15
S RETURN("FugitiveFelonFlag")=$S($$GET1^DIQ(2,DFN,1100.01,"I"):"YES",1:"NO")
D LIST^DIC(26.15,,,"E",,,,,,,"FDATA","ERR")
S (RESNUM,PRFCNT)=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(26.15),U,2)
.K PRFDATA
.D GETINF^DGPFAPIH(DFN,FPTR,,,"PRFDATA") Q:'$D(PRFDATA)
.S PRFCNT=PRFCNT+1
.S RETURN("NationalFlag",PRFCNT,"Name")=$P($G(PRFDATA("FLAG")),U,2)
.S RETURN("NationalFlag",PRFCNT,"Type")=$P($G(PRFDATA("FLAGTYPE")),U,2)
.S RETURN("NationalFlag",PRFCNT,"Category")=$P($G(PRFDATA("CATEGORY")),U)
.S RETURN("NationalFlag",PRFCNT,"AssignedDate")=$$FMTISO^SDAMUTDT($P($G(PRFDATA("ASSIGNDT")),U,1))
.S RETURN("NationalFlag",PRFCNT,"OwnerSiteID")=$P($G(PRFDATA("OWNER")),U)
.S RETURN("NationalFlag",PRFCNT,"OwnerSiteName")=$P($G(PRFDATA("OWNER")),U,2)
.S RETURN("NationalFlag",PRFCNT,"OriginatingSiteID")=$P($G(PRFDATA("ORIGSITE")),U)
.S RETURN("NationalFlag",PRFCNT,"OriginatingSiteName")=$P($G(PRFDATA("ORIGSITE")),U,2)
.S RETURN("NationalFlag",PRFCNT,"ReviewDate")=$$FMTISO^SDAMUTDT($P($G(PRFDATA("REVIEWDT")),U))
.S NARR=0 F S NARR=$O(PRFDATA("NARR",NARR)) Q:'NARR D
..S RETURN("NationalFlag",PRFCNT,"Narrative",NARR)=$G(PRFDATA("NARR",NARR,0))
I '$D(RETURN("NationalFlag")) S RETURN("NationalFlag",1)=""
;
; local flags
N PRFDATA,DFNERROR,DFNERRORS,FN,RESNUM,PRFCNT,FIEN,FPTR,PRFARRY,NARR,FDATA
S FN=26.11
D LIST^DIC(26.11,,,"E",,,,,,,"FDATA","ERR")
S (RESNUM,PRFCNT)=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(26.11),U,2)
.K PRFDATA
.D GETINF^DGPFAPIH(DFN,FPTR,,,"PRFDATA") Q:'$D(PRFDATA)
.S PRFCNT=PRFCNT+1
.S RETURN("LocalFlag",PRFCNT,"Name")=$P($G(PRFDATA("FLAG")),U,2)
.S RETURN("LocalFlag",PRFCNT,"Type")=$P($G(PRFDATA("FLAGTYPE")),U,2)
.S RETURN("LocalFlag",PRFCNT,"Category")=$P($G(PRFDATA("CATEGORY")),U)
.S RETURN("LocalFlag",PRFCNT,"AssignedDate")=$$FMTISO^SDAMUTDT($P($G(PRFDATA("ASSIGNDT")),U,1))
.S RETURN("LocalFlag",PRFCNT,"OwnerSiteID")=$P($G(PRFDATA("OWNER")),U)
.S RETURN("LocalFlag",PRFCNT,"OwnerSiteName")=$P($G(PRFDATA("OWNER")),U,2)
.S RETURN("LocalFlag",PRFCNT,"OriginatingSiteID")=$P($G(PRFDATA("ORIGSITE")),U)
.S RETURN("LocalFlag",PRFCNT,"OriginatingSiteName")=$P($G(PRFDATA("ORIGSITE")),U,2)
.S RETURN("LocalFlag",PRFCNT,"ReviewDate")=$$FMTISO^SDAMUTDT($P($G(PRFDATA("REVIEWDT")),U))
.S NARR=0 F S NARR=$O(PRFDATA("NARR",NARR)) Q:'NARR D
..S RETURN("LocalFlag",PRFCNT,"Narrative",NARR)=$G(PRFDATA("NARR",NARR,0))
I '$D(RETURN("LocalFlag")) S RETURN("LocalFlag",1)=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESPATIENTDATA2 4847 printed Nov 22, 2024@18:07:22 Page 2
SDESPATIENTDATA2 ;ALB/LAB,RRM - VISTA Patient data version 2; JUL 29, 2022@15:22
+1 ;;5.3;Scheduling;**823,824,827**;Aug 13, 1993;Build 10
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ; Documented API's and Integration Agreements
+6 ; -------------------------------------------
+7 ; Reference to ^DPT( In ICRs #7030,7029,1476,10035
+8 ;
+9 ; The intention of this rtn is to return a unique set of data from the Patient
+10 ;File (2) for a specifc IEN.
+11 ;
+12 ; It is assumed by getting here all business logic and validation has been performed.
+13 ;
+14 ; This routine should only be used for retrieving data from the Patient file.
+15 QUIT
PATIENTIDADDDON(RETURN,DFN) ;
+1 ;Returns a basic set of data for a specific appointment
+2 ;
+3 ; Input
+4 ; IEN - Specific appointment IEN
+5 ; Return
+6 ; APPTDATA - Array of field names and the data for the field based on the IEN
+7 ;
+8 NEW FN,IENS,PATDATA,SDMSG,INSRETURN,FUGRET,SENSRET,LOCRET,REGIEN,DATEEDITED,FUGRETIEN,LOCALFLAGIEN,COUNT
+9 KILL RETURN
+10 SET FN=2
SET IENS=DFN_","
+11 DO GETS^DIQ(FN,DFN,".01;.02;.03;.09;.361","IE","PATDATA","SDMSG")
+12 SET RETURN("DFN")=DFN
+13 ;VSE-3648
SET RETURN("ICN")=$$GETPATICN^SDESINPUTVALUTL(DFN)
+14 SET RETURN("Name")=$GET(PATDATA(FN,IENS,.01,"E"))
+15 SET RETURN("Gender")=$GET(PATDATA(FN,IENS,.02,"E"))
+16 SET RETURN("DOBI")=$GET(PATDATA(FN,IENS,.03,"I"))
+17 ;S RETURN("DOBE")=$G(PATDATA(FN,IENS,.03,"E")) - vse 2097 - DG*5.3*804
+18 SET RETURN("DOBE")=$$FMTGMT^SDAMUTDT($GET(PATDATA(FN,IENS,.03,"I")))
+19 SET RETURN("SSN")=$$LAST4SSN^SDESINPUTVALUTL(DFN)
+20 SET RETURN("EligibilityE")=$GET(PATDATA(FN,IENS,.361,"E"))
+21 SET RETURN("EligibilityI")=$GET(PATDATA(FN,IENS,.361,"I"))
+22 ; insurance
+23 DO INSURVERIFYREQ^SDESPATRPC(.INSRETURN,DFN)
+24 SET RETURN("InsuranceVerification")=$GET(INSRETURN(1))
+25 ; sensitive record
+26 DO PTSEC^DGSEC4(.SENSRET,DFN)
+27 SET RETURN("SensitiveRecord")=$GET(SENSRET(1))
+28 ; registration
+29 IF $DATA(^DGS(41.41,"B",DFN))
Begin DoDot:1
+30 SET REGIEN=0
+31 SET REGIEN=$ORDER(^DGS(41.41,"B",DFN,REGIEN))
+32 SET DATEEDITED=$$FMTISO^SDAMUTDT($$GET1^DIQ(41.41,REGIEN,1,"I"))
End DoDot:1
+33 SET RETURN("RegistrationEditDate")=$GET(DATEEDITED)
+34 ; fugitive national flag
+35 NEW PRFDATA,DFNERROR,DFNERRORS,FN,RESNUM,PRFCNT,FIEN,FPTR,PRFARRY,NARR,FDATA
+36 SET FN=26.15
+37 SET RETURN("FugitiveFelonFlag")=$SELECT($$GET1^DIQ(2,DFN,1100.01,"I"):"YES",1:"NO")
+38 DO LIST^DIC(26.15,,,"E",,,,,,,"FDATA","ERR")
+39 SET (RESNUM,PRFCNT)=0
+40 FOR
SET RESNUM=$ORDER(FDATA("DILIST",2,RESNUM))
if 'RESNUM
QUIT
Begin DoDot:1
+41 SET FIEN=$GET(FDATA("DILIST",2,RESNUM))
+42 SET FPTR=FIEN_";"_$PIECE($$ROOT^DILFD(26.15),U,2)
+43 KILL PRFDATA
+44 DO GETINF^DGPFAPIH(DFN,FPTR,,,"PRFDATA")
if '$DATA(PRFDATA)
QUIT
+45 SET PRFCNT=PRFCNT+1
+46 SET RETURN("NationalFlag",PRFCNT,"Name")=$PIECE($GET(PRFDATA("FLAG")),U,2)
+47 SET RETURN("NationalFlag",PRFCNT,"Type")=$PIECE($GET(PRFDATA("FLAGTYPE")),U,2)
+48 SET RETURN("NationalFlag",PRFCNT,"Category")=$PIECE($GET(PRFDATA("CATEGORY")),U)
+49 SET RETURN("NationalFlag",PRFCNT,"AssignedDate")=$$FMTISO^SDAMUTDT($PIECE($GET(PRFDATA("ASSIGNDT")),U,1))
+50 SET RETURN("NationalFlag",PRFCNT,"OwnerSiteID")=$PIECE($GET(PRFDATA("OWNER")),U)
+51 SET RETURN("NationalFlag",PRFCNT,"OwnerSiteName")=$PIECE($GET(PRFDATA("OWNER")),U,2)
+52 SET RETURN("NationalFlag",PRFCNT,"OriginatingSiteID")=$PIECE($GET(PRFDATA("ORIGSITE")),U)
+53 SET RETURN("NationalFlag",PRFCNT,"OriginatingSiteName")=$PIECE($GET(PRFDATA("ORIGSITE")),U,2)
+54 SET RETURN("NationalFlag",PRFCNT,"ReviewDate")=$$FMTISO^SDAMUTDT($PIECE($GET(PRFDATA("REVIEWDT")),U))
+55 SET NARR=0
FOR
SET NARR=$ORDER(PRFDATA("NARR",NARR))
if 'NARR
QUIT
Begin DoDot:2
+56 SET RETURN("NationalFlag",PRFCNT,"Narrative",NARR)=$GET(PRFDATA("NARR",NARR,0))
End DoDot:2
End DoDot:1
+57 IF '$DATA(RETURN("NationalFlag"))
SET RETURN("NationalFlag",1)=""
+58 ;
+59 ; local flags
+60 NEW PRFDATA,DFNERROR,DFNERRORS,FN,RESNUM,PRFCNT,FIEN,FPTR,PRFARRY,NARR,FDATA
+61 SET FN=26.11
+62 DO LIST^DIC(26.11,,,"E",,,,,,,"FDATA","ERR")
+63 SET (RESNUM,PRFCNT)=0
+64 FOR
SET RESNUM=$ORDER(FDATA("DILIST",2,RESNUM))
if 'RESNUM
QUIT
Begin DoDot:1
+65 SET FIEN=$GET(FDATA("DILIST",2,RESNUM))
+66 SET FPTR=FIEN_";"_$PIECE($$ROOT^DILFD(26.11),U,2)
+67 KILL PRFDATA
+68 DO GETINF^DGPFAPIH(DFN,FPTR,,,"PRFDATA")
if '$DATA(PRFDATA)
QUIT
+69 SET PRFCNT=PRFCNT+1
+70 SET RETURN("LocalFlag",PRFCNT,"Name")=$PIECE($GET(PRFDATA("FLAG")),U,2)
+71 SET RETURN("LocalFlag",PRFCNT,"Type")=$PIECE($GET(PRFDATA("FLAGTYPE")),U,2)
+72 SET RETURN("LocalFlag",PRFCNT,"Category")=$PIECE($GET(PRFDATA("CATEGORY")),U)
+73 SET RETURN("LocalFlag",PRFCNT,"AssignedDate")=$$FMTISO^SDAMUTDT($PIECE($GET(PRFDATA("ASSIGNDT")),U,1))
+74 SET RETURN("LocalFlag",PRFCNT,"OwnerSiteID")=$PIECE($GET(PRFDATA("OWNER")),U)
+75 SET RETURN("LocalFlag",PRFCNT,"OwnerSiteName")=$PIECE($GET(PRFDATA("OWNER")),U,2)
+76 SET RETURN("LocalFlag",PRFCNT,"OriginatingSiteID")=$PIECE($GET(PRFDATA("ORIGSITE")),U)
+77 SET RETURN("LocalFlag",PRFCNT,"OriginatingSiteName")=$PIECE($GET(PRFDATA("ORIGSITE")),U,2)
+78 SET RETURN("LocalFlag",PRFCNT,"ReviewDate")=$$FMTISO^SDAMUTDT($PIECE($GET(PRFDATA("REVIEWDT")),U))
+79 SET NARR=0
FOR
SET NARR=$ORDER(PRFDATA("NARR",NARR))
if 'NARR
QUIT
Begin DoDot:2
+80 SET RETURN("LocalFlag",PRFCNT,"Narrative",NARR)=$GET(PRFDATA("NARR",NARR,0))
End DoDot:2
End DoDot:1
+81 IF '$DATA(RETURN("LocalFlag"))
SET RETURN("LocalFlag",1)=""
+82 QUIT
+83 ;
