PXAIVST ;ISL/JVS,KWP,ESW - GET A VISIT FROM ENCOUNTER NODE ; 11/20/02 4:38pm
;;1.0;PCE PATIENT CARE ENCOUNTER;**5,9,15,74,111,96**;Aug 12, 1996
;
;
Q
VST ;--CREAT A VISIT
;
SET ;--SET AND NEW VARIABLES
N AFTER0,AFTER21,AFTER800,AFTER150,BEFOR0,BEFOR21,BEFOR800,BEFOR150
N AFTER811,BEFOR811,BEFOR812
N PXAA,PXAB,SUB,PIECE,STOP
N AFTER8A,AFTER812
;
S SUB="" F S SUB=$O(@PXADATA@("ENCOUNTER",1,SUB)) Q:SUB="" D
.S PXAA(SUB)=@PXADATA@("ENCOUNTER",1,SUB)
;
S (AFTER812,BEFOR812)=""
;
S PXAK=1
S PXAERR(8)=1
S PXAERR(7)="ENCOUNTER"
;
VAL ;--VALIDATE ENOUGH DATA
I $D(@PXADATA@("ENCOUNTER")) D VAL^PXAIVSTV Q:$G(STOP)
I $G(PXAVISIT) S (PATIENT,PXAA("PATIENT"))=$P(^AUPNVSIT(PXAVISIT,0),"^",5) S PXAA("ENC D/T")=$P(^AUPNVSIT(PXAVISIT,0),"^",1)
;
SETVARA ;--SET VISIT VARIABLES
S $P(AFTER0,"^",1)=$G(PXAA("ENC D/T"))
;PX*1*96 - Set TYPE (Piece #3) according to following;
; 1. If OUTSIDE LOCATION then TYPE is "O"
; 2. If no OUTSIDE LOCATION but INSTITUTION then TYPE is "V"
; 3. Else set to value of DUZ("AG")
;Set TYPE
I $L($G(PXAA("OUTSIDE LOCATION"))) S $P(AFTER0,U,3)="O"
E I $L($G(PXAA("INSTITUTION"))) S $P(AFTER0,U,3)="V"
E S $P(AFTER0,U,3)=$G(DUZ("AG"))
S $P(AFTER0,"^",5)=$G(PXAA("PATIENT"))
S $P(AFTER0,"^",6)=$G(PXAA("INSTITUTION"))
S $P(AFTER0,"^",7)=$G(PXAA("SERVICE CATEGORY"))
S $P(AFTER0,"^",8)="" ;$G(PXAA("DSS ID"))
S $P(AFTER0,"^",12)=$G(PXAA("PARENT"))
S $P(AFTER0,"^",18)=$G(PXAA("CHECKOUT D/T"))
S $P(AFTER0,"^",21)=$G(PXAA("ELIGIBILITY"))
S $P(PXELAP,"^",1)=$G(PXAA("ELIGIBILITY"))
S $P(PXELAP,"^",3)=$G(PXAA("APPT"))
S $P(AFTER0,"^",22)=$G(PXAA("HOS LOC"))
S $P(AFTER800,"^",1)=$G(PXAA("SC"))
S $P(AFTER800,"^",2)=$G(PXAA("AO"))
S $P(AFTER800,"^",3)=$G(PXAA("IR"))
S $P(AFTER800,"^",4)=$G(PXAA("EC"))
S $P(AFTER800,"^",5)=$G(PXAA("MST"))
;PX*1*111 - Add HNC
S $P(AFTER800,"^",6)=$G(PXAA("HNC"))
;--VALIDATE SERVICE CONNECTEDNESS
;
S AFTER8A=AFTER800 D VALSCC^PXAIVSTV
S AFTER800=AFTER8A
;
S $P(AFTER21,"^",1)=$G(PXAA("OUTSIDE LOCATION")) ;PX/96
S $P(AFTER150,"^",3)=$G(PXAA("ENCOUNTER TYPE"))
S $P(AFTER811,"^",1)=$G(PXAA("COMMENT"))
S $P(AFTER812,"^",3)=$G(PXASOURC)
SETPXKA ;--SET PXK ARRAY AFTER
S ^TMP("PXK",$J,"VST",1,0,"AFTER")=AFTER0
S ^TMP("PXK",$J,"VST",1,21,"AFTER")=AFTER21
S ^TMP("PXK",$J,"VST",1,150,"AFTER")=AFTER150
S ^TMP("PXK",$J,"VST",1,800,"AFTER")=AFTER800
S ^TMP("PXK",$J,"VST",1,811,"AFTER")=AFTER811
S ^TMP("PXK",$J,"VST",1,812,"AFTER")=AFTER812
SETVARB ;--SET VARIABLES BEFORE
I $G(PXAVISIT) D
.F PIECE=0,21,150,800,811,812 S ^TMP("PXK",$J,"VST",1,PIECE,"BEFORE")=$G(^AUPNVSIT(PXAVISIT,PIECE))
.I '$D(@PXADATA@("ENCOUNTER")) D
..F PIECE=0,21,150,800,811,812 S ^TMP("PXK",$J,"VST",1,PIECE,"AFTER")=$G(^AUPNVSIT(PXAVISIT,PIECE))
E D
.S (BEFOR0,BEFOR21,BEFOR150,BEFOR800,BEFOR811)=""
.;
SETPXKB .;--SET PXK ARRAY BEFORE
.S ^TMP("PXK",$J,"VST",1,0,"BEFORE")=BEFOR0
.S ^TMP("PXK",$J,"VST",1,21,"BEFORE")=BEFOR21
.S ^TMP("PXK",$J,"VST",1,150,"BEFORE")=BEFOR150
.S ^TMP("PXK",$J,"VST",1,800,"BEFORE")=BEFOR800
.S ^TMP("PXK",$J,"VST",1,811,"BEFORE")=BEFOR811
.S ^TMP("PXK",$J,"VST",1,812,"BEFORE")=BEFOR812
MISC ;--MISCELLANEOUS NODE
S ^TMP("PXK",$J,"VST",1,"IEN")=$G(PXAVISIT)
;
CALL ;--CALL
S PXALOOK=$$LOOKVSIT^PXUTLVST($P(AFTER0,U,5),$P(AFTER0,U),$P(AFTER0,U,22),$P(AFTER0,"^",8),$P(AFTER0,U,6)) I $G(PXALOOK)>0 S PXAVISIT=PXALOOK ;PX/96 - included INSTITUTION - $P(AFTER0,U,6)
D EN1^PXKMAIN
I '$G(PXAVISIT) S PXAVISIT=$G(^TMP("PXK",$J,"VST",1,"IEN"))
Q
PXAIVST ;ISL/JVS,KWP,ESW - GET A VISIT FROM ENCOUNTER NODE ; 11/20/02 4:38pm
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**5,9,15,74,111,96**;Aug 12, 1996
+2 ;
+3 ;
+4 QUIT
VST ;--CREAT A VISIT
+1 ;
SET ;--SET AND NEW VARIABLES
+1 NEW AFTER0,AFTER21,AFTER800,AFTER150,BEFOR0,BEFOR21,BEFOR800,BEFOR150
+2 NEW AFTER811,BEFOR811,BEFOR812
+3 NEW PXAA,PXAB,SUB,PIECE,STOP
+4 NEW AFTER8A,AFTER812
+5 ;
+6 SET SUB=""
FOR
SET SUB=$ORDER(@PXADATA@("ENCOUNTER",1,SUB))
IF SUB=""
QUIT
Begin DoDot:1
+7 SET PXAA(SUB)=@PXADATA@("ENCOUNTER",1,SUB)
End DoDot:1
+8 ;
+9 SET (AFTER812,BEFOR812)=""
+10 ;
+11 SET PXAK=1
+12 SET PXAERR(8)=1
+13 SET PXAERR(7)="ENCOUNTER"
+14 ;
VAL ;--VALIDATE ENOUGH DATA
+1 IF $DATA(@PXADATA@("ENCOUNTER"))
DO VAL^PXAIVSTV
IF $GET(STOP)
QUIT
+2 IF $GET(PXAVISIT)
SET (PATIENT,PXAA("PATIENT"))=$PIECE(^AUPNVSIT(PXAVISIT,0),"^",5)
SET PXAA("ENC D/T")=$PIECE(^AUPNVSIT(PXAVISIT,0),"^",1)
+3 ;
SETVARA ;--SET VISIT VARIABLES
+1 SET $PIECE(AFTER0,"^",1)=$GET(PXAA("ENC D/T"))
+2 ;PX*1*96 - Set TYPE (Piece #3) according to following;
+3 ; 1. If OUTSIDE LOCATION then TYPE is "O"
+4 ; 2. If no OUTSIDE LOCATION but INSTITUTION then TYPE is "V"
+5 ; 3. Else set to value of DUZ("AG")
+6 ;Set TYPE
+7 IF $LENGTH($GET(PXAA("OUTSIDE LOCATION")))
SET $PIECE(AFTER0,U,3)="O"
+8 IF '$TEST
IF $LENGTH($GET(PXAA("INSTITUTION")))
SET $PIECE(AFTER0,U,3)="V"
+9 IF '$TEST
SET $PIECE(AFTER0,U,3)=$GET(DUZ("AG"))
+10 SET $PIECE(AFTER0,"^",5)=$GET(PXAA("PATIENT"))
+11 SET $PIECE(AFTER0,"^",6)=$GET(PXAA("INSTITUTION"))
+12 SET $PIECE(AFTER0,"^",7)=$GET(PXAA("SERVICE CATEGORY"))
+13 ;$G(PXAA("DSS ID"))
SET $PIECE(AFTER0,"^",8)=""
+14 SET $PIECE(AFTER0,"^",12)=$GET(PXAA("PARENT"))
+15 SET $PIECE(AFTER0,"^",18)=$GET(PXAA("CHECKOUT D/T"))
+16 SET $PIECE(AFTER0,"^",21)=$GET(PXAA("ELIGIBILITY"))
+17 SET $PIECE(PXELAP,"^",1)=$GET(PXAA("ELIGIBILITY"))
+18 SET $PIECE(PXELAP,"^",3)=$GET(PXAA("APPT"))
+19 SET $PIECE(AFTER0,"^",22)=$GET(PXAA("HOS LOC"))
+20 SET $PIECE(AFTER800,"^",1)=$GET(PXAA("SC"))
+21 SET $PIECE(AFTER800,"^",2)=$GET(PXAA("AO"))
+22 SET $PIECE(AFTER800,"^",3)=$GET(PXAA("IR"))
+23 SET $PIECE(AFTER800,"^",4)=$GET(PXAA("EC"))
+24 SET $PIECE(AFTER800,"^",5)=$GET(PXAA("MST"))
+25 ;PX*1*111 - Add HNC
+26 SET $PIECE(AFTER800,"^",6)=$GET(PXAA("HNC"))
+27 ;--VALIDATE SERVICE CONNECTEDNESS
+28 ;
+29 SET AFTER8A=AFTER800
DO VALSCC^PXAIVSTV
+30 SET AFTER800=AFTER8A
+31 ;
+32 ;PX/96
SET $PIECE(AFTER21,"^",1)=$GET(PXAA("OUTSIDE LOCATION"))
+33 SET $PIECE(AFTER150,"^",3)=$GET(PXAA("ENCOUNTER TYPE"))
+34 SET $PIECE(AFTER811,"^",1)=$GET(PXAA("COMMENT"))
+35 SET $PIECE(AFTER812,"^",3)=$GET(PXASOURC)
SETPXKA ;--SET PXK ARRAY AFTER
+1 SET ^TMP("PXK",$JOB,"VST",1,0,"AFTER")=AFTER0
+2 SET ^TMP("PXK",$JOB,"VST",1,21,"AFTER")=AFTER21
+3 SET ^TMP("PXK",$JOB,"VST",1,150,"AFTER")=AFTER150
+4 SET ^TMP("PXK",$JOB,"VST",1,800,"AFTER")=AFTER800
+5 SET ^TMP("PXK",$JOB,"VST",1,811,"AFTER")=AFTER811
+6 SET ^TMP("PXK",$JOB,"VST",1,812,"AFTER")=AFTER812
SETVARB ;--SET VARIABLES BEFORE
+1 IF $GET(PXAVISIT)
Begin DoDot:1
+2 FOR PIECE=0,21,150,800,811,812
SET ^TMP("PXK",$JOB,"VST",1,PIECE,"BEFORE")=$GET(^AUPNVSIT(PXAVISIT,PIECE))
+3 IF '$DATA(@PXADATA@("ENCOUNTER"))
Begin DoDot:2
+4 FOR PIECE=0,21,150,800,811,812
SET ^TMP("PXK",$JOB,"VST",1,PIECE,"AFTER")=$GET(^AUPNVSIT(PXAVISIT,PIECE))
End DoDot:2
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET (BEFOR0,BEFOR21,BEFOR150,BEFOR800,BEFOR811)=""
+7 ;
SETPXKB ;--SET PXK ARRAY BEFORE
+1 SET ^TMP("PXK",$JOB,"VST",1,0,"BEFORE")=BEFOR0
+2 SET ^TMP("PXK",$JOB,"VST",1,21,"BEFORE")=BEFOR21
+3 SET ^TMP("PXK",$JOB,"VST",1,150,"BEFORE")=BEFOR150
+4 SET ^TMP("PXK",$JOB,"VST",1,800,"BEFORE")=BEFOR800
+5 SET ^TMP("PXK",$JOB,"VST",1,811,"BEFORE")=BEFOR811
+6 SET ^TMP("PXK",$JOB,"VST",1,812,"BEFORE")=BEFOR812
End DoDot:1
MISC ;--MISCELLANEOUS NODE
+1 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=$GET(PXAVISIT)
+2 ;
CALL ;--CALL
+1 ;PX/96 - included INSTITUTION - $P(AFTER0,U,6)
SET PXALOOK=$$LOOKVSIT^PXUTLVST($PIECE(AFTER0,U,5),$PIECE(AFTER0,U),$PIECE(AFTER0,U,22),$PIECE(AFTER0,"^",8),$PIECE(AFTER0,U,6))
IF $GET(PXALOOK)>0
SET PXAVISIT=PXALOOK
+2 DO EN1^PXKMAIN
+3 IF '$GET(PXAVISIT)
SET PXAVISIT=$GET(^TMP("PXK",$JOB,"VST",1,"IEN"))
+4 QUIT
