NHINVAPT ;SLC/MKB -- Appointment extract
;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
;
; External References DBIA#
; ------------------- -----
; DIQ 2056
; SDAMA201 3859
; VADPT 10061
;
; ------------ Get appointment(s) from VistA ------------
;
EN(DFN,BEG,END,MAX,ID) ; -- find patient's appointments
N NHICNT,NHITOT,NHI,X1,X2,X3,X12,NHITM
S DFN=+$G(DFN) Q:DFN<1
S BEG=$G(BEG,DT),END=$G(END,9999998),MAX=$G(MAX,999999)
;
; get one appt
I $L($G(ID)) D Q
. S (BEG,END)=$P(ID,";",2)
. D GETAPPT^SDAMA201(DFN,"1;2;3;12","",BEG,END,.NHITOT)
. I NHITOT>0 F NHI=1:1:NHITOT D
.. S X1=+$G(^TMP($J,"SDAMA201","GETAPPT",NHI,1)),X2=$G(^(2)),X3=$G(^(3)),X12=$G(^(12))
.. Q:+X2'=$P(ID,";",3) ;not same location
.. D EN1(X1,X2,X3,X12,.NHITM),XML(.NHITM)
. K ^TMP($J,"SDAMA201","GETAPPT")
;
; get all [future] appointments
D GETAPPT^SDAMA201(DFN,"1;2;3;12","",BEG,END,.NHITOT)
I NHITOT>0 S NHICNT=0 F NHI=1:1:NHITOT D Q:NHICNT'<MAX
. S X1=+$G(^TMP($J,"SDAMA201","GETAPPT",NHI,1)),X2=+$G(^(2)),X3=$G(^(3))
. ;no cancelled, or prior kept appointments [ORWCV]
. Q:X3="C" I X1<DT,(X3="R"!(X3="NT")) Q
. K NHITM D EN1(X1,X2,X3,X12,.NHITM) Q:'$D(NHITM)
. D XML(.NHITM) S NHICNT=NHICNT+1
K ^TMP($J,"SDAMA201","GETAPPT")
Q
;
EN1(DATE,HLOC,STS,CLS,APPT) ; -- return an appointment in APPT("attribute")=value
N X,VIEN K APPT
S DATE=+$G(DATE),HLOC=$G(HLOC),STS=$G(STS),CLS=$G(CLS)
S APPT("id")="A;"_DATE_";"_+HLOC,APPT("dateTime")=DATE I HLOC D
. S APPT("location")=$P(HLOC,U,2)
. S APPT("type")=U_$P(HLOC,U,2)_" APPOINTMENT"
. S X=$$GET1^DIQ(44,+HLOC_",",9.5,"I")
. I X S APPT("service")=$$SERV(X)
S APPT("facility")=$$FAC^NHINV(+HLOC)
S APPT("patientClass")=$S(CLS="I":"IMP",1:"AMB")
S APPT("serviceCategory")=$S(CLS="I":"I^INPATIENT VISIT",1:"A^AMBULATORY")
S X=$S(STS="N":"NO-SHOW",STS="C":"CANCELLED",STS="R":"SCHEDULED/KEPT",STS="NT":"NO ACTION TAKEN",1:"")
S:$L(X) APPT("apptStatus")=X
S APPT("visitString")=+HLOC_";"_DATE_";A"
Q
;
SERV(FTS) ; -- Return #42.4 Service for a Facility Treating Specialty
N Y S Y="",FTS=+$G(FTS)
S Y=$$GET1^DIQ(45.7,FTS_",","1:3","E")
Q Y
;
; ------------ Return data to middle tier ------------
;
XML(APPT) ; -- Return appointment as XML
N ATT,X,Y,NAMES
D ADD("<appointment>") S NHINTOTL=$G(NHINTOTL)+1
S ATT="" F S ATT=$O(APPT(ATT)) Q:ATT="" D
. S X=$G(APPT(ATT)),Y="" Q:'$L(X)
. I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />"
. I $L(X)>1 S NAMES="code^name^Z",Y="<"_ATT_" "_$$LOOP_"/>"
. D:$L(Y) ADD(Y)
D ADD("</appointment>")
Q
;
LOOP() ; -- build sub-items string from NAMES and X
N STR,P,TAG S STR=""
F P=1:1 S TAG=$P(NAMES,U,P) Q:TAG="Z" I $L($P(X,U,P)) S STR=STR_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
Q STR
;
ADD(X) ; -- Add a line @NHIN@(n)=X
S NHINI=$G(NHINI)+1
S @NHIN@(NHINI)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNHINVAPT 2952 printed Sep 23, 2025@19:53:37 Page 2
NHINVAPT ;SLC/MKB -- Appointment extract
+1 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
+2 ;
+3 ; External References DBIA#
+4 ; ------------------- -----
+5 ; DIQ 2056
+6 ; SDAMA201 3859
+7 ; VADPT 10061
+8 ;
+9 ; ------------ Get appointment(s) from VistA ------------
+10 ;
EN(DFN,BEG,END,MAX,ID) ; -- find patient's appointments
+1 NEW NHICNT,NHITOT,NHI,X1,X2,X3,X12,NHITM
+2 SET DFN=+$GET(DFN)
if DFN<1
QUIT
+3 SET BEG=$GET(BEG,DT)
SET END=$GET(END,9999998)
SET MAX=$GET(MAX,999999)
+4 ;
+5 ; get one appt
+6 IF $LENGTH($GET(ID))
Begin DoDot:1
+7 SET (BEG,END)=$PIECE(ID,";",2)
+8 DO GETAPPT^SDAMA201(DFN,"1;2;3;12","",BEG,END,.NHITOT)
+9 IF NHITOT>0
FOR NHI=1:1:NHITOT
Begin DoDot:2
+10 SET X1=+$GET(^TMP($JOB,"SDAMA201","GETAPPT",NHI,1))
SET X2=$GET(^(2))
SET X3=$GET(^(3))
SET X12=$GET(^(12))
+11 ;not same location
if +X2'=$PIECE(ID,";",3)
QUIT
+12 DO EN1(X1,X2,X3,X12,.NHITM)
DO XML(.NHITM)
End DoDot:2
+13 KILL ^TMP($JOB,"SDAMA201","GETAPPT")
End DoDot:1
QUIT
+14 ;
+15 ; get all [future] appointments
+16 DO GETAPPT^SDAMA201(DFN,"1;2;3;12","",BEG,END,.NHITOT)
+17 IF NHITOT>0
SET NHICNT=0
FOR NHI=1:1:NHITOT
Begin DoDot:1
+18 SET X1=+$GET(^TMP($JOB,"SDAMA201","GETAPPT",NHI,1))
SET X2=+$GET(^(2))
SET X3=$GET(^(3))
+19 ;no cancelled, or prior kept appointments [ORWCV]
+20 if X3="C"
QUIT
IF X1<DT
IF (X3="R"!(X3="NT"))
QUIT
+21 KILL NHITM
DO EN1(X1,X2,X3,X12,.NHITM)
if '$DATA(NHITM)
QUIT
+22 DO XML(.NHITM)
SET NHICNT=NHICNT+1
End DoDot:1
if NHICNT'<MAX
QUIT
+23 KILL ^TMP($JOB,"SDAMA201","GETAPPT")
+24 QUIT
+25 ;
EN1(DATE,HLOC,STS,CLS,APPT) ; -- return an appointment in APPT("attribute")=value
+1 NEW X,VIEN
KILL APPT
+2 SET DATE=+$GET(DATE)
SET HLOC=$GET(HLOC)
SET STS=$GET(STS)
SET CLS=$GET(CLS)
+3 SET APPT("id")="A;"_DATE_";"_+HLOC
SET APPT("dateTime")=DATE
IF HLOC
Begin DoDot:1
+4 SET APPT("location")=$PIECE(HLOC,U,2)
+5 SET APPT("type")=U_$PIECE(HLOC,U,2)_" APPOINTMENT"
+6 SET X=$$GET1^DIQ(44,+HLOC_",",9.5,"I")
+7 IF X
SET APPT("service")=$$SERV(X)
End DoDot:1
+8 SET APPT("facility")=$$FAC^NHINV(+HLOC)
+9 SET APPT("patientClass")=$SELECT(CLS="I":"IMP",1:"AMB")
+10 SET APPT("serviceCategory")=$SELECT(CLS="I":"I^INPATIENT VISIT",1:"A^AMBULATORY")
+11 SET X=$SELECT(STS="N":"NO-SHOW",STS="C":"CANCELLED",STS="R":"SCHEDULED/KEPT",STS="NT":"NO ACTION TAKEN",1:"")
+12 if $LENGTH(X)
SET APPT("apptStatus")=X
+13 SET APPT("visitString")=+HLOC_";"_DATE_";A"
+14 QUIT
+15 ;
SERV(FTS) ; -- Return #42.4 Service for a Facility Treating Specialty
+1 NEW Y
SET Y=""
SET FTS=+$GET(FTS)
+2 SET Y=$$GET1^DIQ(45.7,FTS_",","1:3","E")
+3 QUIT Y
+4 ;
+5 ; ------------ Return data to middle tier ------------
+6 ;
XML(APPT) ; -- Return appointment as XML
+1 NEW ATT,X,Y,NAMES
+2 DO ADD("<appointment>")
SET NHINTOTL=$GET(NHINTOTL)+1
+3 SET ATT=""
FOR
SET ATT=$ORDER(APPT(ATT))
if ATT=""
QUIT
Begin DoDot:1
+4 SET X=$GET(APPT(ATT))
SET Y=""
if '$LENGTH(X)
QUIT
+5 IF X'["^"
SET Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />"
+6 IF $LENGTH(X)>1
SET NAMES="code^name^Z"
SET Y="<"_ATT_" "_$$LOOP_"/>"
+7 if $LENGTH(Y)
DO ADD(Y)
End DoDot:1
+8 DO ADD("</appointment>")
+9 QUIT
+10 ;
LOOP() ; -- build sub-items string from NAMES and X
+1 NEW STR,P,TAG
SET STR=""
+2 FOR P=1:1
SET TAG=$PIECE(NAMES,U,P)
if TAG="Z"
QUIT
IF $LENGTH($PIECE(X,U,P))
SET STR=STR_TAG_"='"_$$ESC^NHINV($PIECE(X,U,P))_"' "
+3 QUIT STR
+4 ;
ADD(X) ; -- Add a line @NHIN@(n)=X
+1 SET NHINI=$GET(NHINI)+1
+2 SET @NHIN@(NHINI)=X
+3 QUIT
