PXAIVST.m

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