SDES2PATDATA ;ALB/LAB,RRM,TJB,TJB - VISTA Patient data version 2; JAN 23, 2024
;;5.3;Scheduling;**867,869**;Aug 13, 1993;Build 13
;;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
; $$ROOT^DILFD ICR #: 2055
; GETINF^DGPFAPIH ICR #: 4903
;
; 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
PATIENTADDON(RETURN,DFN,SDDUZ) ;
;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,FLAG,IENS,PATDATA,SDMSG,INSRETURN,FUGRET,SENSRET,LOCRET,REGIEN,DATEEDITED,FUGRETIEN,LOCALFLAGIEN,COUNT,SENSITIVE
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 NEEDVERIFY^SDESPATRPC(.FLAG,DFN,180,90)
S RETURN("NeedInsuranceVerification")=FLAG
; sensitive record
D SENSITIVE^SDES2UTIL(.SENSITIVE,DFN,SDDUZ)
;D PTSEC^DGSEC4(.SENSRET,DFN)
S RETURN("SensitiveRecord")=$G(SENSITIVE(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[HSDES2PATDATA 4978 printed Nov 22, 2024@18:04:21 Page 2
SDES2PATDATA ;ALB/LAB,RRM,TJB,TJB - VISTA Patient data version 2; JAN 23, 2024
+1 ;;5.3;Scheduling;**867,869**;Aug 13, 1993;Build 13
+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 ; $$ROOT^DILFD ICR #: 2055
+9 ; GETINF^DGPFAPIH ICR #: 4903
+10 ;
+11 ; The intention of this rtn is to return a unique set of data from the Patient
+12 ;File (2) for a specifc IEN.
+13 ;
+14 ; It is assumed by getting here all business logic and validation has been performed.
+15 ;
+16 ; This routine should only be used for retrieving data from the Patient file.
+17 QUIT
PATIENTADDON(RETURN,DFN,SDDUZ) ;
+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,FLAG,IENS,PATDATA,SDMSG,INSRETURN,FUGRET,SENSRET,LOCRET,REGIEN,DATEEDITED,FUGRETIEN,LOCALFLAGIEN,COUNT,SENSITIVE
+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 NEEDVERIFY^SDESPATRPC(.FLAG,DFN,180,90)
+24 SET RETURN("NeedInsuranceVerification")=FLAG
+25 ; sensitive record
+26 DO SENSITIVE^SDES2UTIL(.SENSITIVE,DFN,SDDUZ)
+27 ;D PTSEC^DGSEC4(.SENSRET,DFN)
+28 SET RETURN("SensitiveRecord")=$GET(SENSITIVE(1))
+29 ; registration
+30 IF $DATA(^DGS(41.41,"B",DFN))
Begin DoDot:1
+31 SET REGIEN=0
+32 SET REGIEN=$ORDER(^DGS(41.41,"B",DFN,REGIEN))
+33 SET DATEEDITED=$$FMTISO^SDAMUTDT($$GET1^DIQ(41.41,REGIEN,1,"I"))
End DoDot:1
+34 SET RETURN("RegistrationEditDate")=$GET(DATEEDITED)
+35 ; fugitive national flag
+36 NEW PRFDATA,DFNERROR,DFNERRORS,FN,RESNUM,PRFCNT,FIEN,FPTR,PRFARRY,NARR,FDATA
+37 SET FN=26.15
+38 SET RETURN("FugitiveFelonFlag")=$SELECT($$GET1^DIQ(2,DFN,1100.01,"I"):"YES",1:"NO")
+39 DO LIST^DIC(26.15,,,"E",,,,,,,"FDATA","ERR")
+40 SET (RESNUM,PRFCNT)=0
+41 FOR
SET RESNUM=$ORDER(FDATA("DILIST",2,RESNUM))
if 'RESNUM
QUIT
Begin DoDot:1
+42 SET FIEN=$GET(FDATA("DILIST",2,RESNUM))
+43 SET FPTR=FIEN_";"_$PIECE($$ROOT^DILFD(26.15),U,2)
+44 KILL PRFDATA
+45 DO GETINF^DGPFAPIH(DFN,FPTR,,,"PRFDATA")
if '$DATA(PRFDATA)
QUIT
+46 SET PRFCNT=PRFCNT+1
+47 SET RETURN("NationalFlag",PRFCNT,"Name")=$PIECE($GET(PRFDATA("FLAG")),U,2)
+48 SET RETURN("NationalFlag",PRFCNT,"Type")=$PIECE($GET(PRFDATA("FLAGTYPE")),U,2)
+49 SET RETURN("NationalFlag",PRFCNT,"Category")=$PIECE($GET(PRFDATA("CATEGORY")),U)
+50 SET RETURN("NationalFlag",PRFCNT,"AssignedDate")=$$FMTISO^SDAMUTDT($PIECE($GET(PRFDATA("ASSIGNDT")),U,1))
+51 SET RETURN("NationalFlag",PRFCNT,"OwnerSiteID")=$PIECE($GET(PRFDATA("OWNER")),U)
+52 SET RETURN("NationalFlag",PRFCNT,"OwnerSiteName")=$PIECE($GET(PRFDATA("OWNER")),U,2)
+53 SET RETURN("NationalFlag",PRFCNT,"OriginatingSiteID")=$PIECE($GET(PRFDATA("ORIGSITE")),U)
+54 SET RETURN("NationalFlag",PRFCNT,"OriginatingSiteName")=$PIECE($GET(PRFDATA("ORIGSITE")),U,2)
+55 SET RETURN("NationalFlag",PRFCNT,"ReviewDate")=$$FMTISO^SDAMUTDT($PIECE($GET(PRFDATA("REVIEWDT")),U))
+56 SET NARR=0
FOR
SET NARR=$ORDER(PRFDATA("NARR",NARR))
if 'NARR
QUIT
Begin DoDot:2
+57 SET RETURN("NationalFlag",PRFCNT,"Narrative",NARR)=$GET(PRFDATA("NARR",NARR,0))
End DoDot:2
End DoDot:1
+58 IF '$DATA(RETURN("NationalFlag"))
SET RETURN("NationalFlag",1)=""
+59 ;
+60 ; local flags
+61 NEW PRFDATA,DFNERROR,DFNERRORS,FN,RESNUM,PRFCNT,FIEN,FPTR,PRFARRY,NARR,FDATA
+62 SET FN=26.11
+63 DO LIST^DIC(26.11,,,"E",,,,,,,"FDATA","ERR")
+64 SET (RESNUM,PRFCNT)=0
+65 FOR
SET RESNUM=$ORDER(FDATA("DILIST",2,RESNUM))
if 'RESNUM
QUIT
Begin DoDot:1
+66 SET FIEN=$GET(FDATA("DILIST",2,RESNUM))
+67 SET FPTR=FIEN_";"_$PIECE($$ROOT^DILFD(26.11),U,2)
+68 KILL PRFDATA
+69 DO GETINF^DGPFAPIH(DFN,FPTR,,,"PRFDATA")
if '$DATA(PRFDATA)
QUIT
+70 SET PRFCNT=PRFCNT+1
+71 SET RETURN("LocalFlag",PRFCNT,"Name")=$PIECE($GET(PRFDATA("FLAG")),U,2)
+72 SET RETURN("LocalFlag",PRFCNT,"Type")=$PIECE($GET(PRFDATA("FLAGTYPE")),U,2)
+73 SET RETURN("LocalFlag",PRFCNT,"Category")=$PIECE($GET(PRFDATA("CATEGORY")),U)
+74 SET RETURN("LocalFlag",PRFCNT,"AssignedDate")=$$FMTISO^SDAMUTDT($PIECE($GET(PRFDATA("ASSIGNDT")),U,1))
+75 SET RETURN("LocalFlag",PRFCNT,"OwnerSiteID")=$PIECE($GET(PRFDATA("OWNER")),U)
+76 SET RETURN("LocalFlag",PRFCNT,"OwnerSiteName")=$PIECE($GET(PRFDATA("OWNER")),U,2)
+77 SET RETURN("LocalFlag",PRFCNT,"OriginatingSiteID")=$PIECE($GET(PRFDATA("ORIGSITE")),U)
+78 SET RETURN("LocalFlag",PRFCNT,"OriginatingSiteName")=$PIECE($GET(PRFDATA("ORIGSITE")),U,2)
+79 SET RETURN("LocalFlag",PRFCNT,"ReviewDate")=$$FMTISO^SDAMUTDT($PIECE($GET(PRFDATA("REVIEWDT")),U))
+80 SET NARR=0
FOR
SET NARR=$ORDER(PRFDATA("NARR",NARR))
if 'NARR
QUIT
Begin DoDot:2
+81 SET RETURN("LocalFlag",PRFCNT,"Narrative",NARR)=$GET(PRFDATA("NARR",NARR,0))
End DoDot:2
End DoDot:1
+82 IF '$DATA(RETURN("LocalFlag"))
SET RETURN("LocalFlag",1)=""
+83 QUIT
+84 ;
