BLRDPT5 ; IHS/DIR/FJE - PATIENT VARIABLES ;
;;5.2;BLR;;NOV 01, 1997
;
;;MAS VERSION 5.0;
10 ;Registration/Disposition [REG]
S VARP("C")=$S('$D(VARP("C")):999999999,'VARP("C"):999999999,1:+VARP("C")),VARP("F")=$S('$D(VARP("F")):0,VARP("F")?7N.E:VARP("F"),1:0),VARP("T")=$S('$D(VARP("T")):0,VARP("T")?7N.E:VARP("T"),1:0)
I VARP("F") S VARP("F")=$P(VARP("F"),".",1)_"."_$S($P(VARP("F"),".",2):$P(VARP("F"),".",2),1:""),VARP("F")=9999999=VARP("F")
I VARP("T") S VARP("T")=$P(VARP("T"),".",1)_"."_$S($P(VARP("T"),".",2):$P(VARP("T"),".",2),1:999999),VARP("T")=9999999-VARP("T")
S VAX=VARP("T"),VAX(1)=0 F I=0:0 S VAX=$O(^DPT(DFN,"DIS",VAX)) Q:VAX=""!(VAX<VARP("F"))!(VAX(1)+1>VARP("C")) S VAX(2)=^(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",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]
D NOW^%DTC S VASD("F")=$S('$D(VASD("F")):%,VASD("F")?7N.E:VASD("F"),1:%),VASD("T")=$S($D(VASD("T")):+VASD("T"),1:0),VASD("W")=$S('$D(VASD("W")):12,1:VASD("W")),VAZ(2)=$S($D(VASD("N")):VASD("N"),1:9999) S:'VASD("T") VASD("T")=999999999999999
S VAZ="^I^N^NA^C^CA^PC^PCA^",VAZ(1)="^" F I=1:1 S I1=+$E(VASD("W"),I) Q:'I1 S VAZ(1)=VAZ(1)_$P(VAZ,"^",I1)_"^"
I VASD("T")<99999999 S VASD("T")=$P(VASD("T"),".",1)_"."_$S($P(VASD("T"),".",2):$P(VASD("T"),".",2),1:2359)
S VASD("C")=0 I $O(VASD("C",0))>0 S VASD("C")=1
S VAX=VASD("F"),VAX(1)=0 F I=0:0 S VAX=$O(^DPT(DFN,"S",VAX)) Q:VAX'>0!(VAX>VASD("T"))!(VAX(1)'<VAZ(2)) S VAZ=$S($D(^DPT(DFN,"S",VAX,0)):^(0),1:"") I VAZ,$P(VAZ,"^",2)=""!(VAZ(1)[("^"_$P(VAZ,"^",2)_"^")) D 121,122:VAX(5)
Q
121 S VAX(5)=1 I VASD("W")'[1,$P(VAZ,"^",2)']"" S VAX(5)=0 Q
I VASD("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 S Y=+VAX X ^DD("DD") S $P(VAX("E"),"^",1)=Y,Y=$P(VAZ,"^",1),$P(VAX("E"),"^",2)=$S($D(^SC(+Y,0)):$P(^(0),"^",1),1:""),Y=+$P(VAX("I"),"^",4),$P(VAX("E"),"^",4)=$S($D(^SD(409.1,+Y,0)):$P(^(0),"^",1),1:"")
S Y=$P(VAX("I"),"^",3) 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,@VAV@(VAX(1),"I")=VAX("I"),@VAV@(VAX(1),"E")=VAX("E") Q
BLRDPT5 ; IHS/DIR/FJE - PATIENT VARIABLES ;
+1 ;;5.2;BLR;;NOV 01, 1997
+2 ;
+3 ;;MAS VERSION 5.0;
10 ;Registration/Disposition [REG]
+1 SET VARP("C")=$SELECT('$DATA(VARP("C")):999999999,'VARP("C"):999999999,1:+VARP("C"))
SET VARP("F")=$SELECT('$DATA(VARP("F")):0,VARP("F")?7N.E:VARP("F"),1:0)
SET VARP("T")=$SELECT('$DATA(VARP("T")):0,VARP("T")?7N.E:VARP("T"),1:0)
+2 IF VARP("F")
SET VARP("F")=$PIECE(VARP("F"),".",1)_"."_$SELECT($PIECE(VARP("F"),".",2):$PIECE(VARP("F"),".",2),1:"")
SET VARP("F")=9999999=VARP("F")
+3 IF VARP("T")
SET VARP("T")=$PIECE(VARP("T"),".",1)_"."_$SELECT($PIECE(VARP("T"),".",2):$PIECE(VARP("T"),".",2),1:999999)
SET VARP("T")=9999999-VARP("T")
+4 SET VAX=VARP("T")
SET VAX(1)=0
FOR I=0:0
SET VAX=$ORDER(^DPT(DFN,"DIS",VAX))
IF VAX=""!(VAX<VARP("F"))!(VAX(1)+1>VARP("C"))
QUIT
SET VAX(2)=^(VAX,0)
SET VAX(1)=VAX(1)+1
IF +VAX(2)>0
DO 101
+5 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",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 DO NOW^%DTC
SET VASD("F")=$SELECT('$DATA(VASD("F")):%,VASD("F")?7N.E:VASD("F"),1:%)
SET VASD("T")=$SELECT($DATA(VASD("T")):+VASD("T"),1:0)
SET VASD("W")=$SELECT('$DATA(VASD("W")):12,1:VASD("W"))
SET VAZ(2)=$SELECT($DATA(VASD("N")):VASD("N"),1:9999)
IF 'VASD("T")
SET VASD("T")=999999999999999
+2 SET VAZ="^I^N^NA^C^CA^PC^PCA^"
SET VAZ(1)="^"
FOR I=1:1
SET I1=+$EXTRACT(VASD("W"),I)
IF 'I1
QUIT
SET VAZ(1)=VAZ(1)_$PIECE(VAZ,"^",I1)_"^"
+3 IF VASD("T")<99999999
SET VASD("T")=$PIECE(VASD("T"),".",1)_"."_$SELECT($PIECE(VASD("T"),".",2):$PIECE(VASD("T"),".",2),1:2359)
+4 SET VASD("C")=0
IF $ORDER(VASD("C",0))>0
SET VASD("C")=1
+5 SET VAX=VASD("F")
SET VAX(1)=0
FOR I=0:0
SET VAX=$ORDER(^DPT(DFN,"S",VAX))
IF VAX'>0!(VAX>VASD("T"))!(VAX(1)'<VAZ(2))
QUIT
SET VAZ=$SELECT($DATA(^DPT(DFN,"S",VAX,0)):^(0),1:"")
IF VAZ
IF $PIECE(VAZ,"^",2)=""!(VAZ(1)[("^"_$PIECE(VAZ,"^",2)_"^"))
DO 121
IF VAX(5)
DO 122
+6 QUIT
121 SET VAX(5)=1
IF VASD("W")'[1
IF $PIECE(VAZ,"^",2)']""
SET VAX(5)=0
QUIT
+1 IF VASD("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 SET Y=+VAX
XECUTE ^DD("DD")
SET $PIECE(VAX("E"),"^",1)=Y
SET Y=$PIECE(VAZ,"^",1)
SET $PIECE(VAX("E"),"^",2)=$SELECT($DATA(^SC(+Y,0)):$PIECE(^(0),"^",1),1:"")
SET Y=+$PIECE(VAX("I"),"^",4)
SET $PIECE(VAX("E"),"^",4)=$SELECT($DATA(^SD(409.1,+Y,0)):$PIECE(^(0),"^",1),1:"")
+1 SET Y=$PIECE(VAX("I"),"^",3)
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)
+2 SET VAX(1)=VAX(1)+1
SET @VAV@(VAX(1),"I")=VAX("I")
SET @VAV@(VAX(1),"E")=VAX("E")
QUIT
