VPSAPPT ;SLOIFO/BT - VPS Appointment RPC;1/16/15 11:55
;;1.0;VA POINT OF SERVICE (KIOSKS);**5**;Jan 16, 2015;Build 31
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External Reference DBIA#
; ------------------------
; #3860 - DGPFAPI call (Controlled Sub)
; #10035 - ^DPT( references (Supported)
; #4433 - SDAMA301 call (Supported)
; #2462 - ^DGEN( reference (Controlled Sub)
; ###### - File 2.98, Field 17 (Cancellation Remark) (Private)
QUIT
;
GET(VPSAPPT,VPSQUEUE,VPSFRDT,VPSTODT) ; VPS GET APPOINTMENTS
; This RPC returns all appointments for a given appointment date range.
; Those appointments will also be stored in VPS Appointment queue (File 853.9).
; This queue is used by GETCHG^VPSAPPT2 to filter out the non-change appontments during retrieval.
;
; INPUT
; VPSQUEUE : Unique Queue ID represents Vecna Appointment Queue.
; VPSFRDT : Appointment From Date
; VPSTODT : Appointment Through Date
; OUTPUT
; VPSAPPT : Name of Global array contains all retrieved appointments
; Output Format:
; ^TMP("VPSAPPT",$J,SEQ)=TODO^APPOINTMENT ID^RECORD FLAG#^FIELD NAME^FIELD VALUE
; TODO : instruct vecna to add appointment into the queue and also notify for any error
; APPOINTMENT ID : represent appointment record in the VPS Appointment queue
; RECORD FLAG# : record flag number for patient (1..n) - use only for record flag field
; FIELD NAME : Field name
; FIELD VALUE : Field value
;
; Output Samples:
; ^TMP("VPSAPPT",$J,0)=ERR^^^PARAMETER^error message <--- notify Vecna for parameter error
; ^TMP("VPSAPPT",$J,SEQ)=ERR^99^^ERROR^error message <--- notify Vecna that there is an issue during adding appt ien #99 to the queue
; ^TMP("VPSAPPT",$J,SEQ)=ADD^111^^<FIELD NAME>^FIELD VALUE <--- notify Vecna to add entry #111 to the queue with those field values
; ^TMP("VPSAPPT",$J,SEQ)=ADD^111^1^<FLAG FIELD NAME>^FIELD VALUE <--- notify Vecna to add record flag #1 to entry #111 to the queue
;
; <FIELD NAME> is a member of
; CLINIC IEN^CLINIC NAME^APPT DATE
; DFN^PATIENT NAME^SSN^EMAIL
; APPT TYPE IEN^APPT TYPE NAME^APPT COMMENTS
; APPT STATUS IEN^APPT STATUS NAME^DISPLAYED APPT STATUS
; BAD ADDRESS INDICATOR^BAD ADDRESS NAME
; SENSITIVE,BALANCE,ENROLLMENT STATUS,ENROLLMENT STATUS NAME
; PRE-REGISTRATION DATE CHANGED,ELIGIBILITY STATUS,ELIGIBILITY STATUS NAME
; INELIGIBLE DATE^MEANS TEST STATUS^INSURANCE
; <FLAG FIELD NAME> is a member of
; FLAG INDICATOR^FLAG TYPE^FLAG NAME^FLAG NARRATIVE
;
S VPSAPPT=$NA(^TMP("VPSAPPT",$J)) K @VPSAPPT ; return as global array
I $G(VPSQUEUE)="" D ADDERR("ERR^^^PARAM^QUEUE ID IS REQUIRED") QUIT
I $G(VPSFRDT)="" D ADDERR("ERR^^^PARAM^FROM DATE IS REQUIRED") QUIT
I $G(VPSTODT)="" D ADDERR("ERR^^^PARAM^THROUGH DATE IS REQUIRED") QUIT
K ^TMP($J,"SDAMA301")
;
N OK S OK=$$ADDQUEUE(VPSQUEUE,VPSFRDT,VPSTODT) ; create queue entry
I OK D
. N APPTCNT S APPTCNT=$$POPAPPTS(VPSFRDT,VPSTODT) ; populate ^TMP($J,"SDAMA301") using supported API given appointment from - through date
. D:APPTCNT>0 CMPAPPTS(VPSQUEUE) ; stored appointments in the vps appointment queue file and result array
;
K ^TMP($J,"SDAMA301")
QUIT
;
ADDERR(MSG) ;add error message to result array
S ^TMP("VPSAPPT",$J,0)=MSG
QUIT
;
ADDQUEUE(QUEUEID,FROM,THROUGH) ; create queue entry
; INPUT
; QUEUEID : Unique Queue ID represents Vecna Appointment Queue.
; FROM : Appointment From Date
; THROUGH : Appointment Through Date
;
K ^VPS(853.9,QUEUEID)
N VPSFDA,VPSERR,IENS
S IENS(1)=QUEUEID
S VPSFDA(853.9,"+1,",.01)=QUEUEID
S VPSFDA(853.9,"+1,",1)=FROM
S VPSFDA(853.9,"+1,",2)=THROUGH
D UPDATE^DIE("E","VPSFDA","IENS","VPSERR")
N OK S OK='$D(DIERR)
D:'OK ADDERR("ERR"_U_U_U_"FILE"_U_VPSERR("DIERR",1,"TEXT",1))
K DIERR,VPSFDA,VPSERR,IENS
QUIT OK
;
POPAPPTS(VPSFRDT,VPSTODT) ; populate ^TMP($J,"SDAMA301") using supported API given appointment from - through date
; INPUT
; VPSFRDT : Appointment From Date
; VPSTODT : Appointment Through Date
;
N DGARRAY
S DGARRAY(1)=VPSFRDT_";"_VPSTODT
S DGARRAY("FLDS")="1;2;4;10;22" ;get appt date, clinic and appointment status
QUIT $$SDAPI^SDAMA301(.DGARRAY)
;
CMPAPPTS(QUEUEID) ; stored appointments in the vps appointment queue file and result array
; INPUT
; QUEUEID : Unique Queue ID represents Vecna Appointment Queue.
;
N APPTINFO,APPT,APPTDT
N CLIEN S CLIEN=0
F S CLIEN=$O(^TMP($J,"SDAMA301",CLIEN)) QUIT:'CLIEN D
. N DFN S DFN=0
. F S DFN=$O(^TMP($J,"SDAMA301",CLIEN,DFN)) QUIT:'DFN D:$D(^DPT(DFN,0))
. . S APPTDT=0
. . F S APPTDT=$O(^TMP($J,"SDAMA301",CLIEN,DFN,APPTDT)) QUIT:'APPTDT D
. . . S APPTINFO=$G(^TMP($J,"SDAMA301",CLIEN,DFN,APPTDT))
. . . D GETAPPT(.APPT,APPTINFO)
. . . N TODO S TODO=$$ADDAPPT(QUEUEID,.APPT) ;add the appointment to temporary storage (File #853.9)
. . . D ADDTMP(TODO,QUEUEID,.APPT) ;add the appointment to result array
QUIT
;
GETAPPT(APPT,APPTINFO) ; return the required appointment information
; INPUT
; APPTINFO : Appointment Information returned by $$SDAPI^SDAMA301 containing clinic, patient, appt date, and appointment status
; OUTPUT
; APPT : Array by Reference - Extended appointment information for Vecna to display in the queue
; APPT(FLD) = VALUE
; APPT("PRF",PRF) = FLAG INDICATOR^FLAG TYPE^FLAG NAME^FLAG NARRATIVE (1..n)
; RETURN
;
; -- get appointment date
K APPT S APPT("APPT DATE/TIME")=$P(APPTINFO,U)
;
; -- get clinic info
S APPT("CLINIC IEN")=$P($P(APPTINFO,U,2),";")
S APPT("CLINIC NAME")=$P($P(APPTINFO,U,2),";",2)
;
; -- get patient info
S APPT("DFN")=$P($P(APPTINFO,U,4),";")
S APPT("PATIENT NAME")=$P($P(APPTINFO,U,4),";",2)
N RES D GETS^DIQ(2,APPT("DFN")_",",".09;.133","E","RES")
S APPT("SSN")=$G(RES(2,DFN_",",.09,"E"))
S APPT("EMAIL")=$G(RES(2,DFN_",",.133,"E"))
;
D GETPRF(APPT("DFN"),.APPT) ;populate APPT array with patient record flags and narrative
;
; -- get appointment type
N APPTYP S APPTYP=$P(APPTINFO,U,10)
S APPT("APPT TYPE IEN")=$P(APPTYP,";") ;appt type ien
S APPT("APPT TYPE NAME")=$P(APPTYP,";",2) ;appt type name
;
; -- get cancellation remarks
N IENS S IENS=APPT("APPT DATE/TIME")_","_APPT("DFN")_","
N APPTOUT D GETS^DIQ(2.98,IENS,"17","IE","APPTOUT")
S APPT("APPT COMMENTS")=$G(APPTOUT(2.98,IENS,17,"I"))
;
; -- get appointment status
N STATUS S STATUS=$P(APPTINFO,U,22)
S APPT("APPT STATUS IEN")=$P(STATUS,";") ;status ien
S APPT("APPT STATUS NAME")=$P(STATUS,";",2) ;status name
S APPT("DISPLAYED APPT STATUS")=$P(STATUS,";",3) ;Print Status (what is displayed)
;
; -- get Bad Address Indicator
N BADADR S BADADR=$$BADADR^DGUTL3(DFN)
I BADADR'="" D
. N BADADRNM S BADADRNM=""
. I BADADR=1 S BADADRNM="UNDELIVERABLE"
. I BADADR=2 S BADADRNM="HOMELESS"
. I BADADR=3 S BADADRNM="OTHER"
. S APPT("BAD ADDRESS INDICATOR")=BADADR
. S APPT("BAD ADDRESS NAME")=BADADRNM
;
; -- get Sensitive
N VPSARR D SENLOG^VPSRPC16(.VPSARR,DFN)
N SENS S SENS=$P($G(VPSARR(1)),U,4)
S:SENS'="" APPT("SENSITIVE")=SENS
;
; -- get Balance
K VPSARR D BAL^VPSRPC26(.VPSARR,DFN)
N BAL S BAL=$P($G(VPSARR(1)),U,4)
S:BAL'="" APPT("BALANCE")=BAL
;
; -- Get Enrollment Status
N ENRIEN S ENRIEN=$O(^DGEN(27.11,"C",DFN,""),-1)
I ENRIEN D
. N DFENR D GET^DGENA(ENRIEN,.DGENR)
. N ENRSTAT S ENRSTAT=$G(DGENR("STATUS"))
. I ENRSTAT'="" D
. . N ESNAME S ESNAME=$$GET1^DIQ(27.11,ENRIEN_",",.04,"E")
. . S APPT("ENROLLMENT STATUS")=ENRSTAT
. . S APPT("ENROLLMENT STATUS NAME")=ESNAME
;
; -- get Pre-Registration Date Changed
K VPSARR D DGS^VPSRPC26(.VPSARR,DFN)
N PRDT S PRDT=$P($G(VPSARR(1)),U,4)
S:PRDT'="" APPT("PRE-REGISTRATION DATE CHANGED")=PRDT
;
; -- get Eligibility Code
N VAEL D ELIG^VADPT
N ELIGSTAT S ELIGSTAT=$P($G(VAEL(8)),U)
I ELIGSTAT'="" D
. S APPT("ELIGIBILITY STATUS")=ELIGSTAT
. S ELIGSTAT=$P($G(VAEL(8)),U,2)
. S APPT("ELIGIBILITY STATUS NAME")=ELIGSTAT
;
; -- get Ineligible date
N IELIGDT S IELIGDT=$P($G(VAEL(5,1)),U)
S:IELIGDT'="" APPT("INELIGIBLE DATE")=IELIGDT
;
; -- get Means Test Status
N MTS S MTS=$P($G(VAEL(9)),U,2)
S:MTS'="" APPT("MEANS TEST STATUS")=MTS
;
; -- get Insurance (true/false)
K VPSARR D IBB^VPSRPC26(.VPSARR,DFN) ; Insurance Info
N INS S INS=$P($G(VPSARR(1)),U,4)
S INS=$S(INS'="":"Y",1:"N")
S APPT("INSURANCE")=INS
;
QUIT
;
GETPRF(DFN,PRFLAGS) ;populate PRFLAGS with patient record flags and narrative
;INPUT : DFN - Patient IEN
;OUTPUT: PRFLAGS - Patient Record Flags array
;
N PRF,REC,NPRF S NPRF=$$GETACT^DGPFAPI(DFN,"REC") ;Retrieve all ACTIVE Patient record flag assignments
N FLAG,FLAGTYPE,PRFLAG,PRFFIL,FLAGFROM,FLAGNAME,NARR,FLAGINFO
;
F PRF=1:1:NPRF D
. ;store flag type
. S FLAGTYPE=$P(REC(PRF,"FLAGTYPE"),U,2)
. S PRFLAG=$P(REC(PRF,"FLAG"),U)
. S FLAGFROM=""
. I FLAGTYPE'="",PRFLAG'="" D
. . S PRFFIL=$P($P(PRFLAG,"DGPF(",2),",")
. . I PRFFIL'="" S FLAGFROM=$S(PRFFIL=26.11:"LOCAL",1:"NATIONAL")
. . I PRFFIL="" S FLAGTYPE=""
. S FLAGNAME=$P(REC(PRF,"FLAG"),U,2)
. S PRFLAGS("PRF",PRF,"FLAG ORIGINATION")=FLAGFROM
. S PRFLAGS("PRF",PRF,"FLAG TYPE")=FLAGTYPE
. S PRFLAGS("PRF",PRF,"FLAG NAME")=FLAGNAME
. M PRFLAGS("PRF.NARR",PRF)=REC(PRF,"NARR")
QUIT
;
GETNARR(PRF,REC) ; Get ASSIGNMENT NARRATIVE (word-processing)
N VAL,NARR S NARR=""
N NARRCNT S NARRCNT=""
F S NARRCNT=$O(REC(PRF,"NARR",NARRCNT)) QUIT:NARRCNT="" D
. S VAL=$G(REC(PRF,"NARR",NARRCNT,0))
. S NARR=NARR_VAL_U
S:$E(NARR,$L(NARR))=U NARR=$E(NARR,1,$L(NARR)-1)
QUIT NARR
;
ADDAPPT(QUEUEID,APPT) ; add appointment to sub file 853.91
; INPUT
; QUEUEID : Unique Queue ID represents Vecna Appointment Queue.
; APPT(FLD): Array contains value of FIELD
; CLINIC IEN, APPT DATE, DFN, APPT TYPE, DISPLAY APPT STATUS
; All Values are required
; RETURN
; TODO : ADD <-- successfully add the appointment
; : ERR^ERRORMESSAGE <-- failed adding the appointment with ERROR MESSAGE
;
N TODO S TODO="ADD"
N VPSFDA,VPSERR,DIERR
S VPSFDA(853.91,"+1,"_QUEUEID_",",.01)=APPT("CLINIC IEN") ;clinic ien
S VPSFDA(853.91,"+1,"_QUEUEID_",",1)=APPT("APPT DATE/TIME") ;appointment date
S VPSFDA(853.91,"+1,"_QUEUEID_",",2)=APPT("DFN") ;patient ien
S VPSFDA(853.91,"+1,"_QUEUEID_",",3)=APPT("APPT TYPE IEN") ;appt type ien
S VPSFDA(853.91,"+1,"_QUEUEID_",",4)=APPT("DISPLAYED APPT STATUS") ;displayed/printed version of appt status
D UPDATE^DIE("","VPSFDA","","VPSERR")
I $D(DIERR) S TODO="ERR"_U_VPSERR("DIERR",1,"TEXT",1)
K DIERR,VPSFDA,VPSERR
QUIT TODO
;
ADDTMP(TODO,QUEUEID,APPT) ; add appointment to result array
; INPUT
; TODO : Instruction to vecna what todo with the appointment (ADD or ERR)
; QUEUEID : Unique Queue ID represents Vecna Appointment Queue.
; APPT(FLD) : Array contains value of FLD
; APPT("PRF",PRF): RECORD FLAG
; : FLAG ORIGINATION (NATIONAL/LOCAL)^FLAG TYPE^FLAG NAME^FLAG NARRATIVE (1..n)
;
N SEQ S SEQ=$O(^TMP("VPSAPPT",$J,""),-1)+1
N CLIEN S CLIEN=APPT("CLINIC IEN") ;clinic ien
N APPTDT S APPTDT=APPT("APPT DATE/TIME") ;appointment date
N DFN S DFN=APPT("DFN") ;patient ien
N APPTIEN S APPTIEN=$$GETIEN^VPSAPPT(QUEUEID,CLIEN,APPTDT,DFN)
I $P(TODO,U)="ERR" D SAVTMP("ERR",APPTIEN,,"ERROR",$P(TODO,U,2)) QUIT
;
; -- Save appointment fields other than RECORD FLAG
N FLD S FLD=""
F S FLD=$O(APPT(FLD)) Q:FLD="" D:$E(FLD,1,3)'="PRF" SAVTMP(TODO,APPTIEN,,FLD,APPT(FLD))
;
; -- save patient record flag
N SEQ S SEQ=0
N CNT S CNT=""
F S SEQ=$O(APPT("PRF",SEQ)) Q:'SEQ D
. F S FLD=$O(APPT("PRF",SEQ,FLD)) Q:FLD="" D
. . D SAVTMP(TODO,APPTIEN,SEQ,FLD,APPT("PRF",SEQ,FLD))
. F S CNT=$O(APPT("PRF.NARR",SEQ,CNT)) Q:CNT="" D
. . D SAVTMP(TODO,APPTIEN,SEQ,"FLAG NARRATIVE "_CNT,$G(APPT("PRF.NARR",SEQ,CNT,0)))
;
QUIT
;
SAVTMP(TODO,APPTIEN,SEQ,FLD,DATA) ;save data to result global array
N LAST S LAST=$O(^TMP("VPSAPPT",$J,""),-1)+1
S ^TMP("VPSAPPT",$J,LAST)=TODO_U_APPTIEN_U_$G(SEQ)_U_$G(FLD)_U_DATA
QUIT
;
GETIEN(QUEUEID,CLIEN,APPTDT,DFN) ; return the IEN for sub file 853.91 record
; INPUT
; QUEUEID : Unique Queue ID represents Vecna Appointment Queue.
; CLIEN : Clinic IEN
; APPTDT : Appointment Date
; DFN : Patient IEN
; RETURN
; APPOINTMENT IEN in the queue
;
QUIT:'QUEUEID!'CLIEN!'APPTDT!'DFN ""
N APPTIEN S APPTIEN=$O(^VPS(853.9,QUEUEID,1,"C",CLIEN,APPTDT,DFN,""))
QUIT APPTIEN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPSAPPT 12879 printed Dec 13, 2024@02:42:58 Page 2
VPSAPPT ;SLOIFO/BT - VPS Appointment RPC;1/16/15 11:55
+1 ;;1.0;VA POINT OF SERVICE (KIOSKS);**5**;Jan 16, 2015;Build 31
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; External Reference DBIA#
+5 ; ------------------------
+6 ; #3860 - DGPFAPI call (Controlled Sub)
+7 ; #10035 - ^DPT( references (Supported)
+8 ; #4433 - SDAMA301 call (Supported)
+9 ; #2462 - ^DGEN( reference (Controlled Sub)
+10 ; ###### - File 2.98, Field 17 (Cancellation Remark) (Private)
+11 QUIT
+12 ;
GET(VPSAPPT,VPSQUEUE,VPSFRDT,VPSTODT) ; VPS GET APPOINTMENTS
+1 ; This RPC returns all appointments for a given appointment date range.
+2 ; Those appointments will also be stored in VPS Appointment queue (File 853.9).
+3 ; This queue is used by GETCHG^VPSAPPT2 to filter out the non-change appontments during retrieval.
+4 ;
+5 ; INPUT
+6 ; VPSQUEUE : Unique Queue ID represents Vecna Appointment Queue.
+7 ; VPSFRDT : Appointment From Date
+8 ; VPSTODT : Appointment Through Date
+9 ; OUTPUT
+10 ; VPSAPPT : Name of Global array contains all retrieved appointments
+11 ; Output Format:
+12 ; ^TMP("VPSAPPT",$J,SEQ)=TODO^APPOINTMENT ID^RECORD FLAG#^FIELD NAME^FIELD VALUE
+13 ; TODO : instruct vecna to add appointment into the queue and also notify for any error
+14 ; APPOINTMENT ID : represent appointment record in the VPS Appointment queue
+15 ; RECORD FLAG# : record flag number for patient (1..n) - use only for record flag field
+16 ; FIELD NAME : Field name
+17 ; FIELD VALUE : Field value
+18 ;
+19 ; Output Samples:
+20 ; ^TMP("VPSAPPT",$J,0)=ERR^^^PARAMETER^error message <--- notify Vecna for parameter error
+21 ; ^TMP("VPSAPPT",$J,SEQ)=ERR^99^^ERROR^error message <--- notify Vecna that there is an issue during adding appt ien #99 to the queue
+22 ; ^TMP("VPSAPPT",$J,SEQ)=ADD^111^^<FIELD NAME>^FIELD VALUE <--- notify Vecna to add entry #111 to the queue with those field values
+23 ; ^TMP("VPSAPPT",$J,SEQ)=ADD^111^1^<FLAG FIELD NAME>^FIELD VALUE <--- notify Vecna to add record flag #1 to entry #111 to the queue
+24 ;
+25 ; <FIELD NAME> is a member of
+26 ; CLINIC IEN^CLINIC NAME^APPT DATE
+27 ; DFN^PATIENT NAME^SSN^EMAIL
+28 ; APPT TYPE IEN^APPT TYPE NAME^APPT COMMENTS
+29 ; APPT STATUS IEN^APPT STATUS NAME^DISPLAYED APPT STATUS
+30 ; BAD ADDRESS INDICATOR^BAD ADDRESS NAME
+31 ; SENSITIVE,BALANCE,ENROLLMENT STATUS,ENROLLMENT STATUS NAME
+32 ; PRE-REGISTRATION DATE CHANGED,ELIGIBILITY STATUS,ELIGIBILITY STATUS NAME
+33 ; INELIGIBLE DATE^MEANS TEST STATUS^INSURANCE
+34 ; <FLAG FIELD NAME> is a member of
+35 ; FLAG INDICATOR^FLAG TYPE^FLAG NAME^FLAG NARRATIVE
+36 ;
+37 ; return as global array
SET VPSAPPT=$NAME(^TMP("VPSAPPT",$JOB))
KILL @VPSAPPT
+38 IF $GET(VPSQUEUE)=""
DO ADDERR("ERR^^^PARAM^QUEUE ID IS REQUIRED")
QUIT
+39 IF $GET(VPSFRDT)=""
DO ADDERR("ERR^^^PARAM^FROM DATE IS REQUIRED")
QUIT
+40 IF $GET(VPSTODT)=""
DO ADDERR("ERR^^^PARAM^THROUGH DATE IS REQUIRED")
QUIT
+41 KILL ^TMP($JOB,"SDAMA301")
+42 ;
+43 ; create queue entry
NEW OK
SET OK=$$ADDQUEUE(VPSQUEUE,VPSFRDT,VPSTODT)
+44 IF OK
Begin DoDot:1
+45 ; populate ^TMP($J,"SDAMA301") using supported API given appointment from - through date
NEW APPTCNT
SET APPTCNT=$$POPAPPTS(VPSFRDT,VPSTODT)
+46 ; stored appointments in the vps appointment queue file and result array
if APPTCNT>0
DO CMPAPPTS(VPSQUEUE)
End DoDot:1
+47 ;
+48 KILL ^TMP($JOB,"SDAMA301")
+49 QUIT
+50 ;
ADDERR(MSG) ;add error message to result array
+1 SET ^TMP("VPSAPPT",$JOB,0)=MSG
+2 QUIT
+3 ;
ADDQUEUE(QUEUEID,FROM,THROUGH) ; create queue entry
+1 ; INPUT
+2 ; QUEUEID : Unique Queue ID represents Vecna Appointment Queue.
+3 ; FROM : Appointment From Date
+4 ; THROUGH : Appointment Through Date
+5 ;
+6 KILL ^VPS(853.9,QUEUEID)
+7 NEW VPSFDA,VPSERR,IENS
+8 SET IENS(1)=QUEUEID
+9 SET VPSFDA(853.9,"+1,",.01)=QUEUEID
+10 SET VPSFDA(853.9,"+1,",1)=FROM
+11 SET VPSFDA(853.9,"+1,",2)=THROUGH
+12 DO UPDATE^DIE("E","VPSFDA","IENS","VPSERR")
+13 NEW OK
SET OK='$DATA(DIERR)
+14 if 'OK
DO ADDERR("ERR"_U_U_U_"FILE"_U_VPSERR("DIERR",1,"TEXT",1))
+15 KILL DIERR,VPSFDA,VPSERR,IENS
+16 QUIT OK
+17 ;
POPAPPTS(VPSFRDT,VPSTODT) ; populate ^TMP($J,"SDAMA301") using supported API given appointment from - through date
+1 ; INPUT
+2 ; VPSFRDT : Appointment From Date
+3 ; VPSTODT : Appointment Through Date
+4 ;
+5 NEW DGARRAY
+6 SET DGARRAY(1)=VPSFRDT_";"_VPSTODT
+7 ;get appt date, clinic and appointment status
SET DGARRAY("FLDS")="1;2;4;10;22"
+8 QUIT $$SDAPI^SDAMA301(.DGARRAY)
+9 ;
CMPAPPTS(QUEUEID) ; stored appointments in the vps appointment queue file and result array
+1 ; INPUT
+2 ; QUEUEID : Unique Queue ID represents Vecna Appointment Queue.
+3 ;
+4 NEW APPTINFO,APPT,APPTDT
+5 NEW CLIEN
SET CLIEN=0
+6 FOR
SET CLIEN=$ORDER(^TMP($JOB,"SDAMA301",CLIEN))
if 'CLIEN
QUIT
Begin DoDot:1
+7 NEW DFN
SET DFN=0
+8 FOR
SET DFN=$ORDER(^TMP($JOB,"SDAMA301",CLIEN,DFN))
if 'DFN
QUIT
if $DATA(^DPT(DFN,0))
Begin DoDot:2
+9 SET APPTDT=0
+10 FOR
SET APPTDT=$ORDER(^TMP($JOB,"SDAMA301",CLIEN,DFN,APPTDT))
if 'APPTDT
QUIT
Begin DoDot:3
+11 SET APPTINFO=$GET(^TMP($JOB,"SDAMA301",CLIEN,DFN,APPTDT))
+12 DO GETAPPT(.APPT,APPTINFO)
+13 ;add the appointment to temporary storage (File #853.9)
NEW TODO
SET TODO=$$ADDAPPT(QUEUEID,.APPT)
+14 ;add the appointment to result array
DO ADDTMP(TODO,QUEUEID,.APPT)
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
GETAPPT(APPT,APPTINFO) ; return the required appointment information
+1 ; INPUT
+2 ; APPTINFO : Appointment Information returned by $$SDAPI^SDAMA301 containing clinic, patient, appt date, and appointment status
+3 ; OUTPUT
+4 ; APPT : Array by Reference - Extended appointment information for Vecna to display in the queue
+5 ; APPT(FLD) = VALUE
+6 ; APPT("PRF",PRF) = FLAG INDICATOR^FLAG TYPE^FLAG NAME^FLAG NARRATIVE (1..n)
+7 ; RETURN
+8 ;
+9 ; -- get appointment date
+10 KILL APPT
SET APPT("APPT DATE/TIME")=$PIECE(APPTINFO,U)
+11 ;
+12 ; -- get clinic info
+13 SET APPT("CLINIC IEN")=$PIECE($PIECE(APPTINFO,U,2),";")
+14 SET APPT("CLINIC NAME")=$PIECE($PIECE(APPTINFO,U,2),";",2)
+15 ;
+16 ; -- get patient info
+17 SET APPT("DFN")=$PIECE($PIECE(APPTINFO,U,4),";")
+18 SET APPT("PATIENT NAME")=$PIECE($PIECE(APPTINFO,U,4),";",2)
+19 NEW RES
DO GETS^DIQ(2,APPT("DFN")_",",".09;.133","E","RES")
+20 SET APPT("SSN")=$GET(RES(2,DFN_",",.09,"E"))
+21 SET APPT("EMAIL")=$GET(RES(2,DFN_",",.133,"E"))
+22 ;
+23 ;populate APPT array with patient record flags and narrative
DO GETPRF(APPT("DFN"),.APPT)
+24 ;
+25 ; -- get appointment type
+26 NEW APPTYP
SET APPTYP=$PIECE(APPTINFO,U,10)
+27 ;appt type ien
SET APPT("APPT TYPE IEN")=$PIECE(APPTYP,";")
+28 ;appt type name
SET APPT("APPT TYPE NAME")=$PIECE(APPTYP,";",2)
+29 ;
+30 ; -- get cancellation remarks
+31 NEW IENS
SET IENS=APPT("APPT DATE/TIME")_","_APPT("DFN")_","
+32 NEW APPTOUT
DO GETS^DIQ(2.98,IENS,"17","IE","APPTOUT")
+33 SET APPT("APPT COMMENTS")=$GET(APPTOUT(2.98,IENS,17,"I"))
+34 ;
+35 ; -- get appointment status
+36 NEW STATUS
SET STATUS=$PIECE(APPTINFO,U,22)
+37 ;status ien
SET APPT("APPT STATUS IEN")=$PIECE(STATUS,";")
+38 ;status name
SET APPT("APPT STATUS NAME")=$PIECE(STATUS,";",2)
+39 ;Print Status (what is displayed)
SET APPT("DISPLAYED APPT STATUS")=$PIECE(STATUS,";",3)
+40 ;
+41 ; -- get Bad Address Indicator
+42 NEW BADADR
SET BADADR=$$BADADR^DGUTL3(DFN)
+43 IF BADADR'=""
Begin DoDot:1
+44 NEW BADADRNM
SET BADADRNM=""
+45 IF BADADR=1
SET BADADRNM="UNDELIVERABLE"
+46 IF BADADR=2
SET BADADRNM="HOMELESS"
+47 IF BADADR=3
SET BADADRNM="OTHER"
+48 SET APPT("BAD ADDRESS INDICATOR")=BADADR
+49 SET APPT("BAD ADDRESS NAME")=BADADRNM
End DoDot:1
+50 ;
+51 ; -- get Sensitive
+52 NEW VPSARR
DO SENLOG^VPSRPC16(.VPSARR,DFN)
+53 NEW SENS
SET SENS=$PIECE($GET(VPSARR(1)),U,4)
+54 if SENS'=""
SET APPT("SENSITIVE")=SENS
+55 ;
+56 ; -- get Balance
+57 KILL VPSARR
DO BAL^VPSRPC26(.VPSARR,DFN)
+58 NEW BAL
SET BAL=$PIECE($GET(VPSARR(1)),U,4)
+59 if BAL'=""
SET APPT("BALANCE")=BAL
+60 ;
+61 ; -- Get Enrollment Status
+62 NEW ENRIEN
SET ENRIEN=$ORDER(^DGEN(27.11,"C",DFN,""),-1)
+63 IF ENRIEN
Begin DoDot:1
+64 NEW DFENR
DO GET^DGENA(ENRIEN,.DGENR)
+65 NEW ENRSTAT
SET ENRSTAT=$GET(DGENR("STATUS"))
+66 IF ENRSTAT'=""
Begin DoDot:2
+67 NEW ESNAME
SET ESNAME=$$GET1^DIQ(27.11,ENRIEN_",",.04,"E")
+68 SET APPT("ENROLLMENT STATUS")=ENRSTAT
+69 SET APPT("ENROLLMENT STATUS NAME")=ESNAME
End DoDot:2
End DoDot:1
+70 ;
+71 ; -- get Pre-Registration Date Changed
+72 KILL VPSARR
DO DGS^VPSRPC26(.VPSARR,DFN)
+73 NEW PRDT
SET PRDT=$PIECE($GET(VPSARR(1)),U,4)
+74 if PRDT'=""
SET APPT("PRE-REGISTRATION DATE CHANGED")=PRDT
+75 ;
+76 ; -- get Eligibility Code
+77 NEW VAEL
DO ELIG^VADPT
+78 NEW ELIGSTAT
SET ELIGSTAT=$PIECE($GET(VAEL(8)),U)
+79 IF ELIGSTAT'=""
Begin DoDot:1
+80 SET APPT("ELIGIBILITY STATUS")=ELIGSTAT
+81 SET ELIGSTAT=$PIECE($GET(VAEL(8)),U,2)
+82 SET APPT("ELIGIBILITY STATUS NAME")=ELIGSTAT
End DoDot:1
+83 ;
+84 ; -- get Ineligible date
+85 NEW IELIGDT
SET IELIGDT=$PIECE($GET(VAEL(5,1)),U)
+86 if IELIGDT'=""
SET APPT("INELIGIBLE DATE")=IELIGDT
+87 ;
+88 ; -- get Means Test Status
+89 NEW MTS
SET MTS=$PIECE($GET(VAEL(9)),U,2)
+90 if MTS'=""
SET APPT("MEANS TEST STATUS")=MTS
+91 ;
+92 ; -- get Insurance (true/false)
+93 ; Insurance Info
KILL VPSARR
DO IBB^VPSRPC26(.VPSARR,DFN)
+94 NEW INS
SET INS=$PIECE($GET(VPSARR(1)),U,4)
+95 SET INS=$SELECT(INS'="":"Y",1:"N")
+96 SET APPT("INSURANCE")=INS
+97 ;
+98 QUIT
+99 ;
GETPRF(DFN,PRFLAGS) ;populate PRFLAGS with patient record flags and narrative
+1 ;INPUT : DFN - Patient IEN
+2 ;OUTPUT: PRFLAGS - Patient Record Flags array
+3 ;
+4 ;Retrieve all ACTIVE Patient record flag assignments
NEW PRF,REC,NPRF
SET NPRF=$$GETACT^DGPFAPI(DFN,"REC")
+5 NEW FLAG,FLAGTYPE,PRFLAG,PRFFIL,FLAGFROM,FLAGNAME,NARR,FLAGINFO
+6 ;
+7 FOR PRF=1:1:NPRF
Begin DoDot:1
+8 ;store flag type
+9 SET FLAGTYPE=$PIECE(REC(PRF,"FLAGTYPE"),U,2)
+10 SET PRFLAG=$PIECE(REC(PRF,"FLAG"),U)
+11 SET FLAGFROM=""
+12 IF FLAGTYPE'=""
IF PRFLAG'=""
Begin DoDot:2
+13 SET PRFFIL=$PIECE($PIECE(PRFLAG,"DGPF(",2),",")
+14 IF PRFFIL'=""
SET FLAGFROM=$SELECT(PRFFIL=26.11:"LOCAL",1:"NATIONAL")
+15 IF PRFFIL=""
SET FLAGTYPE=""
End DoDot:2
+16 SET FLAGNAME=$PIECE(REC(PRF,"FLAG"),U,2)
+17 SET PRFLAGS("PRF",PRF,"FLAG ORIGINATION")=FLAGFROM
+18 SET PRFLAGS("PRF",PRF,"FLAG TYPE")=FLAGTYPE
+19 SET PRFLAGS("PRF",PRF,"FLAG NAME")=FLAGNAME
+20 MERGE PRFLAGS("PRF.NARR",PRF)=REC(PRF,"NARR")
End DoDot:1
+21 QUIT
+22 ;
GETNARR(PRF,REC) ; Get ASSIGNMENT NARRATIVE (word-processing)
+1 NEW VAL,NARR
SET NARR=""
+2 NEW NARRCNT
SET NARRCNT=""
+3 FOR
SET NARRCNT=$ORDER(REC(PRF,"NARR",NARRCNT))
if NARRCNT=""
QUIT
Begin DoDot:1
+4 SET VAL=$GET(REC(PRF,"NARR",NARRCNT,0))
+5 SET NARR=NARR_VAL_U
End DoDot:1
+6 if $EXTRACT(NARR,$LENGTH(NARR))=U
SET NARR=$EXTRACT(NARR,1,$LENGTH(NARR)-1)
+7 QUIT NARR
+8 ;
ADDAPPT(QUEUEID,APPT) ; add appointment to sub file 853.91
+1 ; INPUT
+2 ; QUEUEID : Unique Queue ID represents Vecna Appointment Queue.
+3 ; APPT(FLD): Array contains value of FIELD
+4 ; CLINIC IEN, APPT DATE, DFN, APPT TYPE, DISPLAY APPT STATUS
+5 ; All Values are required
+6 ; RETURN
+7 ; TODO : ADD <-- successfully add the appointment
+8 ; : ERR^ERRORMESSAGE <-- failed adding the appointment with ERROR MESSAGE
+9 ;
+10 NEW TODO
SET TODO="ADD"
+11 NEW VPSFDA,VPSERR,DIERR
+12 ;clinic ien
SET VPSFDA(853.91,"+1,"_QUEUEID_",",.01)=APPT("CLINIC IEN")
+13 ;appointment date
SET VPSFDA(853.91,"+1,"_QUEUEID_",",1)=APPT("APPT DATE/TIME")
+14 ;patient ien
SET VPSFDA(853.91,"+1,"_QUEUEID_",",2)=APPT("DFN")
+15 ;appt type ien
SET VPSFDA(853.91,"+1,"_QUEUEID_",",3)=APPT("APPT TYPE IEN")
+16 ;displayed/printed version of appt status
SET VPSFDA(853.91,"+1,"_QUEUEID_",",4)=APPT("DISPLAYED APPT STATUS")
+17 DO UPDATE^DIE("","VPSFDA","","VPSERR")
+18 IF $DATA(DIERR)
SET TODO="ERR"_U_VPSERR("DIERR",1,"TEXT",1)
+19 KILL DIERR,VPSFDA,VPSERR
+20 QUIT TODO
+21 ;
ADDTMP(TODO,QUEUEID,APPT) ; add appointment to result array
+1 ; INPUT
+2 ; TODO : Instruction to vecna what todo with the appointment (ADD or ERR)
+3 ; QUEUEID : Unique Queue ID represents Vecna Appointment Queue.
+4 ; APPT(FLD) : Array contains value of FLD
+5 ; APPT("PRF",PRF): RECORD FLAG
+6 ; : FLAG ORIGINATION (NATIONAL/LOCAL)^FLAG TYPE^FLAG NAME^FLAG NARRATIVE (1..n)
+7 ;
+8 NEW SEQ
SET SEQ=$ORDER(^TMP("VPSAPPT",$JOB,""),-1)+1
+9 ;clinic ien
NEW CLIEN
SET CLIEN=APPT("CLINIC IEN")
+10 ;appointment date
NEW APPTDT
SET APPTDT=APPT("APPT DATE/TIME")
+11 ;patient ien
NEW DFN
SET DFN=APPT("DFN")
+12 NEW APPTIEN
SET APPTIEN=$$GETIEN^VPSAPPT(QUEUEID,CLIEN,APPTDT,DFN)
+13 IF $PIECE(TODO,U)="ERR"
DO SAVTMP("ERR",APPTIEN,,"ERROR",$PIECE(TODO,U,2))
QUIT
+14 ;
+15 ; -- Save appointment fields other than RECORD FLAG
+16 NEW FLD
SET FLD=""
+17 FOR
SET FLD=$ORDER(APPT(FLD))
if FLD=""
QUIT
if $EXTRACT(FLD,1,3)'="PRF"
DO SAVTMP(TODO,APPTIEN,,FLD,APPT(FLD))
+18 ;
+19 ; -- save patient record flag
+20 NEW SEQ
SET SEQ=0
+21 NEW CNT
SET CNT=""
+22 FOR
SET SEQ=$ORDER(APPT("PRF",SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+23 FOR
SET FLD=$ORDER(APPT("PRF",SEQ,FLD))
if FLD=""
QUIT
Begin DoDot:2
+24 DO SAVTMP(TODO,APPTIEN,SEQ,FLD,APPT("PRF",SEQ,FLD))
End DoDot:2
+25 FOR
SET CNT=$ORDER(APPT("PRF.NARR",SEQ,CNT))
if CNT=""
QUIT
Begin DoDot:2
+26 DO SAVTMP(TODO,APPTIEN,SEQ,"FLAG NARRATIVE "_CNT,$GET(APPT("PRF.NARR",SEQ,CNT,0)))
End DoDot:2
End DoDot:1
+27 ;
+28 QUIT
+29 ;
SAVTMP(TODO,APPTIEN,SEQ,FLD,DATA) ;save data to result global array
+1 NEW LAST
SET LAST=$ORDER(^TMP("VPSAPPT",$JOB,""),-1)+1
+2 SET ^TMP("VPSAPPT",$JOB,LAST)=TODO_U_APPTIEN_U_$GET(SEQ)_U_$GET(FLD)_U_DATA
+3 QUIT
+4 ;
GETIEN(QUEUEID,CLIEN,APPTDT,DFN) ; return the IEN for sub file 853.91 record
+1 ; INPUT
+2 ; QUEUEID : Unique Queue ID represents Vecna Appointment Queue.
+3 ; CLIEN : Clinic IEN
+4 ; APPTDT : Appointment Date
+5 ; DFN : Patient IEN
+6 ; RETURN
+7 ; APPOINTMENT IEN in the queue
+8 ;
+9 if 'QUEUEID!'CLIEN!'APPTDT!'DFN
QUIT ""
+10 NEW APPTIEN
SET APPTIEN=$ORDER(^VPS(853.9,QUEUEID,1,"C",CLIEN,APPTDT,DFN,""))
+11 QUIT APPTIEN
