VADPT5 ;ALB/MRL/MJK - PATIENT VARIABLES [REG]; 14 DEC 1988 ; 8/6/04 7:42am
;;5.3;Registration;**54,63,242,584,749**;Aug 13, 1993;Build 10
10 ;Registration/Disposition [REG]
N VARPSV
S VARPSV("C")=$S('$G(VARP("C")):999999999,1:+VARP("C"))
S VARPSV("F")=9999999-$S($G(VARP("F"))?7N.E:VARP("F"),1:0)
S VARPSV("T")=$S($G(VARP("T"))?7N.E:VARP("T"),1:7777777) I '$P(VARPSV("T"),".",2) S $P(VARPSV("T"),".",2)=999999
S VARPSV("T")=9999999-VARPSV("T")
S VAX=VARPSV("T"),VAX(1)=0
I '$D(^DPT(DFN,"DIS")) Q
F I=0:0 S VAX=$O(^DPT(DFN,"DIS",VAX)) Q:VAX=""!(VAX>VARPSV("F"))!(VAX(1)+1>VARPSV("C")) S VAX(2)=$G(^DPT(DFN,"DIS",VAX,0)),VAX(1)=VAX(1)+1 D 101:+VAX(2)>0
Q
101 S (VAX("I"),VAX("E"))="",VAX(3)=0 F I=1,2,3,4,5,6,7,9 S VAX(3)=VAX(3)+1,$P(VAX("I"),"^",VAX(3))=$P(VAX(2),"^",I) D 102
S @VAV@(VAX(1),"I")=VAX("I"),@VAV@(VAX(1),"E")=VAX("E") Q
102 I "^1^6^"[("^"_VAX(3)_"^") S Y=$P(VAX("I"),"^",VAX(3)) I Y]"" X ^DD("DD") S $P(VAX("E"),"^",VAX(3))=Y Q
S X(1)=$S($D(^DD(2.101,$S(I<9:(I-1),1:I),0)):$P(^(0),"^",3),1:"") I "^2^3^"[("^"_VAX(3)_"^"),$P(VAX("I"),"^",VAX(3))]"",X(1)]"" S $P(VAX("E"),"^",VAX(3))=$P($P(X(1),$P(VAX("I"),"^",VAX(3))_":",2),";",1) Q
I "^4^5^7^8^"[("^"_VAX(3)_"^"),$P(VAX("I"),"^",VAX(3))]"",X(1)]"" S X(1)="^"_X(1)_$P(VAX("I"),"^",VAX(3))_",0)" I $D(@(X(1))) S $P(VAX("E"),"^",VAX(3))=$P(^(0),"^",1)
Q
;
11 ;Clinic Enrollments [SDE]
S (VAX,VAX(1))=0 F I=0:0 S VAX=$O(^DPT(DFN,"DE",VAX)) Q:VAX'>0 S VAZ=$S($D(^DPT(DFN,"DE",VAX,0)):^(0),1:"") I +VAZ,$P(VAZ,"^",2)'="I" S VAX(3)=0 D 111
Q
111 S VAX(4)=0 F I1=0:0 S VAX(4)=$O(^DPT(DFN,"DE",VAX,1,VAX(4))) Q:VAX(4)'>0!(VAX(3)) S VAZ(1)=$S($D(^DPT(DFN,"DE",VAX,1,VAX(4),0)):^(0),1:"") I +VAZ(1),$P(VAZ(1),"^",3)']"" S VAX(3)=VAZ(1)
Q:'VAX(3) S (VAX("I"),VAX("E"))="",Y=+VAX(3),$P(VAX("I"),"^",2)=Y X ^DD("DD") S $P(VAX("E"),"^",2)=Y
S $P(VAX("I"),"^",3)=$P(VAX(3),"^",2) I $P(VAX("I"),"^",3)]"" S $P(VAX("E"),"^",3)=$S($P(VAX("I"),"^",3)="O":"OPT",$P(VAX("I"),"^",3)="A":"AC",1:"")
S $P(VAX("I"),"^",1)=+VAZ,$P(VAX("E"),"^",1)=$S($D(^SC(+VAZ,0)):$P(^(0),"^",1),1:""),VAX(1)=VAX(1)+1,@VAV@(VAX(1),"I")=VAX("I"),@VAV@(VAX(1),"E")=VAX("E") Q
;
12 ;Appointments [SDA]
N VASDSV,SDCNT,SDARRAY,VANOW
S VANOW=$$NOW^XLFDT
S VASDSV("F")=$S($G(VASD("F"))?7N.E:VASD("F"),1:VANOW)
S VASDSV("T")=$S(+$G(VASD("T")):+VASD("T"),1:9999999) I '$P(VASDSV("T"),".",2) S $P(VASDSV("T"),".",2)=999999
S VASDSV("W")=$S('$G(VASD("W")):12,1:VASD("W"))
S VAZ(2)=$S($D(VASD("N")):VASD("N"),1:9999)
;Set STATUS Codes (VistA;RSA)
S VAZ=";R^I;I^N;NS^NA;NSR^C;CC^CA;CCR^PC;CP^PCA;CPR^NT;NT^",VAZ(1)=""
;Extract User Required STATUS Codes in RSA format
F I=1:1 S I1=+$E(VASDSV("W"),I) Q:'I1 D
.S VAZ(1)=VAZ(1)_$P($P(VAZ,"^",I1),";",2)_";"
;Create parameter list for the extrinsic call to the Appointment API
;Note: Appointment API can only accept a maximum of 3 fields
; to filter on.
; 1 : "FROM;TO" Appointment Date Range to Search
; 2 : Clinic IEN or Array of Clinic IENs if defined (Pass the Root)
; 3 : Requested STATUS Codes (Passed if VASD("C") is not defined.)
; 4 : Patient IEN
S SDARRAY="",SDARRAY(1)=VASDSV("F")_";"_VASDSV("T")
I $O(VASD("C",0))>0 S SDARRAY(2)="VASD(""C"","
E S SDARRAY(3)=VAZ(1)
S SDARRAY(4)=DFN
;Set Fields for API to Return
; 1 : Appointment Date/Time
; 2 : Clinic
; 3 : Appointment Status
; 10 : Appointment Type
S SDARRAY("FLDS")="1;2;3;10"
;Remove Clinic IEN from Global Reference
S SDARRAY("SORT")="P"
;Call Appointment API (Pass Array by reference)
S SDCNT=$$SDAPI^SDAMA301(.SDARRAY)
S VAX="",VAX(1)=0
;If error returned, determine error and set VAERR appropriately
; 1 : For any error other than 101
; 2 : If error is 101 : Database is unavailable
I SDCNT<0 S VAX=$O(^TMP($J,"SDAMA301",VAX)) S VAERR=$S(VAX=101:2,1:1) K ^TMP($J,"SDAMA301") Q
D 122:SDCNT>0
Q
121 S VAX(5)=1 I VASDSV("W")'[1,$P(VAZ,"^",2)']"" S VAX(5)=0 Q
I VASDSV("C"),'$D(VASD("C",+VAZ)) S VAX(5)=0 Q
S (VAX("I"),VAX("E"))="",VAX(2)=1,$P(VAX("I"),"^",1)=+VAX F I1=1,2,16 S VAX(2)=VAX(2)+1,$P(VAX("I"),"^",VAX(2))=$P(VAZ,"^",I1)
Q
122 ;Build Internal/External Output Globals
;
N SDCIEN,SDDTM,SDNODE
S (SDCIEN,SDDTM)=""
;Redefine VAZ (STATUS Codes(RSA;VistA))
S VAZ="R;^I;I^NS;N^NSR;NA^CC;C^CCR;CA^CP;PC^CPR;PCA^NT;NT^"
S SDDTM=""
;Loop through appointments and convert for output
F S SDDTM=$O(^TMP($J,"SDAMA301",DFN,SDDTM)) Q:'SDDTM D
.;Get Appointment Information and clear VAX("I") & VAX("E")
.S SDNODE=^(SDDTM),(VAX("I"),VAX("E"))=""
.;If Clinics were passed to appointment API,
.; Filter on Appointment Status Codes
.I $O(VASD("C",0))>0,(VAZ(1)'[($P($P(SDNODE,"^",3),";")_";")) Q
.;Extract and format Appointment Date/Time
.S Y=$P(SDNODE,"^",1)
.S $P(VAX("I"),"^",1)=Y
.X ^DD("DD") S $P(VAX("E"),"^",1)=Y
.;Extract and format Clinic Information
.S $P(VAX("I"),"^",2)=$P($P(SDNODE,"^",2),";",1)
.S $P(VAX("E"),"^",2)=$P($P(SDNODE,"^",2),";",2)
.;Extract and format Appointment Type
.S $P(VAX("I"),"^",4)=$P($P(SDNODE,"^",10),";",1)
.S $P(VAX("E"),"^",4)=$P($P(SDNODE,"^",10),";",2)
.;Extract and format Appointment Status
.S Y=$P($P(VAZ,$P($P(SDNODE,"^",3),";")_";",2),"^"),$P(VAX("I"),"^",3)=Y
.I Y]"" S X=$S($D(^DD(2.98,3,0)):$P(^(0),"^",3),1:""),$P(VAX("E"),"^",3)=$P($P(X,Y_":",2),";",1)
.S VAX(1)=VAX(1)+1
.;Store information in global
.S @VAV@(VAX(1),"I")=VAX("I"),@VAV@(VAX(1),"E")=VAX("E")
K ^TMP($J,"SDAMA301")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVADPT5 5483 printed Sep 23, 2025@20:37:13 Page 2
VADPT5 ;ALB/MRL/MJK - PATIENT VARIABLES [REG]; 14 DEC 1988 ; 8/6/04 7:42am
+1 ;;5.3;Registration;**54,63,242,584,749**;Aug 13, 1993;Build 10
10 ;Registration/Disposition [REG]
+1 NEW VARPSV
+2 SET VARPSV("C")=$SELECT('$GET(VARP("C")):999999999,1:+VARP("C"))
+3 SET VARPSV("F")=9999999-$SELECT($GET(VARP("F"))?7N.E:VARP("F"),1:0)
+4 SET VARPSV("T")=$SELECT($GET(VARP("T"))?7N.E:VARP("T"),1:7777777)
IF '$PIECE(VARPSV("T"),".",2)
SET $PIECE(VARPSV("T"),".",2)=999999
+5 SET VARPSV("T")=9999999-VARPSV("T")
+6 SET VAX=VARPSV("T")
SET VAX(1)=0
+7 IF '$DATA(^DPT(DFN,"DIS"))
QUIT
+8 FOR I=0:0
SET VAX=$ORDER(^DPT(DFN,"DIS",VAX))
if VAX=""!(VAX>VARPSV("F"))!(VAX(1)+1>VARPSV("C"))
QUIT
SET VAX(2)=$GET(^DPT(DFN,"DIS",VAX,0))
SET VAX(1)=VAX(1)+1
if +VAX(2)>0
DO 101
+9 QUIT
101 SET (VAX("I"),VAX("E"))=""
SET VAX(3)=0
FOR I=1,2,3,4,5,6,7,9
SET VAX(3)=VAX(3)+1
SET $PIECE(VAX("I"),"^",VAX(3))=$PIECE(VAX(2),"^",I)
DO 102
+1 SET @VAV@(VAX(1),"I")=VAX("I")
SET @VAV@(VAX(1),"E")=VAX("E")
QUIT
102 IF "^1^6^"[("^"_VAX(3)_"^")
SET Y=$PIECE(VAX("I"),"^",VAX(3))
IF Y]""
XECUTE ^DD("DD")
SET $PIECE(VAX("E"),"^",VAX(3))=Y
QUIT
+1 SET X(1)=$SELECT($DATA(^DD(2.101,$SELECT(I<9:(I-1),1:I),0)):$PIECE(^(0),"^",3),1:"")
IF "^2^3^"[("^"_VAX(3)_"^")
IF $PIECE(VAX("I"),"^",VAX(3))]""
IF X(1)]""
SET $PIECE(VAX("E"),"^",VAX(3))=$PIECE($PIECE(X(1),$PIECE(VAX("I"),"^",VAX(3))_":",2),";",1)
QUIT
+2 IF "^4^5^7^8^"[("^"_VAX(3)_"^")
IF $PIECE(VAX("I"),"^",VAX(3))]""
IF X(1)]""
SET X(1)="^"_X(1)_$PIECE(VAX("I"),"^",VAX(3))_",0)"
IF $DATA(@(X(1)))
SET $PIECE(VAX("E"),"^",VAX(3))=$PIECE(^(0),"^",1)
+3 QUIT
+4 ;
11 ;Clinic Enrollments [SDE]
+1 SET (VAX,VAX(1))=0
FOR I=0:0
SET VAX=$ORDER(^DPT(DFN,"DE",VAX))
if VAX'>0
QUIT
SET VAZ=$SELECT($DATA(^DPT(DFN,"DE",VAX,0)):^(0),1:"")
IF +VAZ
IF $PIECE(VAZ,"^",2)'="I"
SET VAX(3)=0
DO 111
+2 QUIT
111 SET VAX(4)=0
FOR I1=0:0
SET VAX(4)=$ORDER(^DPT(DFN,"DE",VAX,1,VAX(4)))
if VAX(4)'>0!(VAX(3))
QUIT
SET VAZ(1)=$SELECT($DATA(^DPT(DFN,"DE",VAX,1,VAX(4),0)):^(0),1:"")
IF +VAZ(1)
IF $PIECE(VAZ(1),"^",3)']""
SET VAX(3)=VAZ(1)
+1 if 'VAX(3)
QUIT
SET (VAX("I"),VAX("E"))=""
SET Y=+VAX(3)
SET $PIECE(VAX("I"),"^",2)=Y
XECUTE ^DD("DD")
SET $PIECE(VAX("E"),"^",2)=Y
+2 SET $PIECE(VAX("I"),"^",3)=$PIECE(VAX(3),"^",2)
IF $PIECE(VAX("I"),"^",3)]""
SET $PIECE(VAX("E"),"^",3)=$SELECT($PIECE(VAX("I"),"^",3)="O":"OPT",$PIECE(VAX("I"),"^",3)="A":"AC",1:"")
+3 SET $PIECE(VAX("I"),"^",1)=+VAZ
SET $PIECE(VAX("E"),"^",1)=$SELECT($DATA(^SC(+VAZ,0)):$PIECE(^(0),"^",1),1:"")
SET VAX(1)=VAX(1)+1
SET @VAV@(VAX(1),"I")=VAX("I")
SET @VAV@(VAX(1),"E")=VAX("E")
QUIT
+4 ;
12 ;Appointments [SDA]
+1 NEW VASDSV,SDCNT,SDARRAY,VANOW
+2 SET VANOW=$$NOW^XLFDT
+3 SET VASDSV("F")=$SELECT($GET(VASD("F"))?7N.E:VASD("F"),1:VANOW)
+4 SET VASDSV("T")=$SELECT(+$GET(VASD("T")):+VASD("T"),1:9999999)
IF '$PIECE(VASDSV("T"),".",2)
SET $PIECE(VASDSV("T"),".",2)=999999
+5 SET VASDSV("W")=$SELECT('$GET(VASD("W")):12,1:VASD("W"))
+6 SET VAZ(2)=$SELECT($DATA(VASD("N")):VASD("N"),1:9999)
+7 ;Set STATUS Codes (VistA;RSA)
+8 SET VAZ=";R^I;I^N;NS^NA;NSR^C;CC^CA;CCR^PC;CP^PCA;CPR^NT;NT^"
SET VAZ(1)=""
+9 ;Extract User Required STATUS Codes in RSA format
+10 FOR I=1:1
SET I1=+$EXTRACT(VASDSV("W"),I)
if 'I1
QUIT
Begin DoDot:1
+11 SET VAZ(1)=VAZ(1)_$PIECE($PIECE(VAZ,"^",I1),";",2)_";"
End DoDot:1
+12 ;Create parameter list for the extrinsic call to the Appointment API
+13 ;Note: Appointment API can only accept a maximum of 3 fields
+14 ; to filter on.
+15 ; 1 : "FROM;TO" Appointment Date Range to Search
+16 ; 2 : Clinic IEN or Array of Clinic IENs if defined (Pass the Root)
+17 ; 3 : Requested STATUS Codes (Passed if VASD("C") is not defined.)
+18 ; 4 : Patient IEN
+19 SET SDARRAY=""
SET SDARRAY(1)=VASDSV("F")_";"_VASDSV("T")
+20 IF $ORDER(VASD("C",0))>0
SET SDARRAY(2)="VASD(""C"","
+21 IF '$TEST
SET SDARRAY(3)=VAZ(1)
+22 SET SDARRAY(4)=DFN
+23 ;Set Fields for API to Return
+24 ; 1 : Appointment Date/Time
+25 ; 2 : Clinic
+26 ; 3 : Appointment Status
+27 ; 10 : Appointment Type
+28 SET SDARRAY("FLDS")="1;2;3;10"
+29 ;Remove Clinic IEN from Global Reference
+30 SET SDARRAY("SORT")="P"
+31 ;Call Appointment API (Pass Array by reference)
+32 SET SDCNT=$$SDAPI^SDAMA301(.SDARRAY)
+33 SET VAX=""
SET VAX(1)=0
+34 ;If error returned, determine error and set VAERR appropriately
+35 ; 1 : For any error other than 101
+36 ; 2 : If error is 101 : Database is unavailable
+37 IF SDCNT<0
SET VAX=$ORDER(^TMP($JOB,"SDAMA301",VAX))
SET VAERR=$SELECT(VAX=101:2,1:1)
KILL ^TMP($JOB,"SDAMA301")
QUIT
+38 if SDCNT>0
DO 122
+39 QUIT
121 SET VAX(5)=1
IF VASDSV("W")'[1
IF $PIECE(VAZ,"^",2)']""
SET VAX(5)=0
QUIT
+1 IF VASDSV("C")
IF '$DATA(VASD("C",+VAZ))
SET VAX(5)=0
QUIT
+2 SET (VAX("I"),VAX("E"))=""
SET VAX(2)=1
SET $PIECE(VAX("I"),"^",1)=+VAX
FOR I1=1,2,16
SET VAX(2)=VAX(2)+1
SET $PIECE(VAX("I"),"^",VAX(2))=$PIECE(VAZ,"^",I1)
+3 QUIT
122 ;Build Internal/External Output Globals
+1 ;
+2 NEW SDCIEN,SDDTM,SDNODE
+3 SET (SDCIEN,SDDTM)=""
+4 ;Redefine VAZ (STATUS Codes(RSA;VistA))
+5 SET VAZ="R;^I;I^NS;N^NSR;NA^CC;C^CCR;CA^CP;PC^CPR;PCA^NT;NT^"
+6 SET SDDTM=""
+7 ;Loop through appointments and convert for output
+8 FOR
SET SDDTM=$ORDER(^TMP($JOB,"SDAMA301",DFN,SDDTM))
if 'SDDTM
QUIT
Begin DoDot:1
+9 ;Get Appointment Information and clear VAX("I") & VAX("E")
+10 SET SDNODE=^(SDDTM)
SET (VAX("I"),VAX("E"))=""
+11 ;If Clinics were passed to appointment API,
+12 ; Filter on Appointment Status Codes
+13 IF $ORDER(VASD("C",0))>0
IF (VAZ(1)'[($PIECE($PIECE(SDNODE,"^",3),";")_";"))
QUIT
+14 ;Extract and format Appointment Date/Time
+15 SET Y=$PIECE(SDNODE,"^",1)
+16 SET $PIECE(VAX("I"),"^",1)=Y
+17 XECUTE ^DD("DD")
SET $PIECE(VAX("E"),"^",1)=Y
+18 ;Extract and format Clinic Information
+19 SET $PIECE(VAX("I"),"^",2)=$PIECE($PIECE(SDNODE,"^",2),";",1)
+20 SET $PIECE(VAX("E"),"^",2)=$PIECE($PIECE(SDNODE,"^",2),";",2)
+21 ;Extract and format Appointment Type
+22 SET $PIECE(VAX("I"),"^",4)=$PIECE($PIECE(SDNODE,"^",10),";",1)
+23 SET $PIECE(VAX("E"),"^",4)=$PIECE($PIECE(SDNODE,"^",10),";",2)
+24 ;Extract and format Appointment Status
+25 SET Y=$PIECE($PIECE(VAZ,$PIECE($PIECE(SDNODE,"^",3),";")_";",2),"^")
SET $PIECE(VAX("I"),"^",3)=Y
+26 IF Y]""
SET X=$SELECT($DATA(^DD(2.98,3,0)):$PIECE(^(0),"^",3),1:"")
SET $PIECE(VAX("E"),"^",3)=$PIECE($PIECE(X,Y_":",2),";",1)
+27 SET VAX(1)=VAX(1)+1
+28 ;Store information in global
+29 SET @VAV@(VAX(1),"I")=VAX("I")
SET @VAV@(VAX(1),"E")=VAX("E")
End DoDot:1
+30 KILL ^TMP($JOB,"SDAMA301")
+31 QUIT
