PXAISK.m

PXAISK ;ISL/PKR - Set the SKIN TEST nodes. ;12/18/97

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**45**;Aug 12, 1996

 ;

SKIN ;Main entry point.

 ;

 K PXAERR

 S PXAERR(8)=PXAK

 S PXAERR(7)="SKIN TEST"

 ;

 N IND,PXAA

 S IND=""

 F  S IND=$O(@PXADATA@("SKIN TEST",PXAK,IND)) Q:IND=""  D

 . S PXAA(IND)=@PXADATA@("SKIN TEST",PXAK,IND)

 ;

 ;Validate the data.

 N STOP

 D VAL^PXAISKV

 I $G(STOP) Q

 ;

SETVARA ;Set the after visit variables.

 N AFTER0,AFTER12,AFTER811,AFTER812

 S $P(AFTER0,U,1)=$G(PXAA("TEST"))

 I $G(PXAA("DELETE")) S $P(AFTER0,U,1)="@"

 S $P(AFTER0,U,2)=$G(PATIENT)

 S $P(AFTER0,U,3)=$G(PXAVISIT)

 S $P(AFTER0,U,4)=$G(PXAA("RESULT"))

 S $P(AFTER0,U,5)=$G(PXAA("READING"))

 S $P(AFTER0,U,6)=$G(PXAA("D/T READ"))

 S $P(AFTER12,U,1)=$G(PXAA("EVENT D/T"))

 S $P(AFTER12,U,4)=$G(PXAA("ENC PROVIDER"))

 S $P(AFTER811,U,1)=$G(PXAA("COMMENT"))

 ;

 ;--PACKAGE AND SOURCE

 S $P(AFTER812,"^",2)=$G(PXAPKG)

 S $P(AFTER812,"^",3)=$G(PXASOURC)

 ;

 S ^TMP("PXK",$J,"SK",PXAK,0,"AFTER")=AFTER0

 S ^TMP("PXK",$J,"SK",PXAK,12,"AFTER")=AFTER12

 S ^TMP("PXK",$J,"SK",PXAK,811,"AFTER")=AFTER811

 S ^TMP("PXK",$J,"SK",PXAK,812,"AFTER")=AFTER812

 ;

SETVARB ;Set the before variables.

 N BEFOR0,BEFOR12,BEFOR811,BEFOR812

 N IENB,PXAAX,PXBCNT,PXBKY,PXBSKY,PXBSAM

 D SK^PXBGSK(PXAVISIT)

 ;

 S IENB=""

 I PXBCNT>0 D

 . S PXAAX("TEST")=$P($G(^AUTTSK(PXAA("TEST"),0)),U,1)

 . S IENB=$O(PXBKY(PXAAX("TEST"),IENB))

 I $G(IENB) D

 . S BEFOR0=$G(^AUPNVSK(IENB,0))

 . S BEFOR12=$G(^AUPNVSK(IENB,12))

 . S BEFOR811=$G(^AUPNVSK(IENB,811))

 . S BEFOR812=$G(^AUPNVSK(IENB,812))

 E  S (BEFOR0,BEFOR11,BEFOR12,BEFOR811,BEFOR812)=""

 ;

 S ^TMP("PXK",$J,"SK",PXAK,0,"BEFORE")=BEFOR0

 S ^TMP("PXK",$J,"SK",PXAK,12,"BEFORE")=BEFOR12

 S ^TMP("PXK",$J,"SK",PXAK,811,"BEFORE")=BEFOR811

 S ^TMP("PXK",$J,"SK",PXAK,812,"BEFORE")=BEFOR812

 S ^TMP("PXK",$J,"SK",PXAK,"IEN")=IENB

 ;

 Q

PXAISK    ;ISL/PKR - Set the SKIN TEST nodes. ;12/18/97

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**45**;Aug 12, 1996

 +2       ;

SKIN      ;Main entry point.

 +1       ;

 +2        KILL PXAERR

 +3        SET PXAERR(8)=PXAK

 +4        SET PXAERR(7)="SKIN TEST"

 +5       ;

 +6        NEW IND,PXAA

 +7        SET IND=""

 +8        FOR 

               SET IND=$ORDER(@PXADATA@("SKIN TEST",PXAK,IND))

               IF IND=""

                   QUIT 

               Begin DoDot:1

 +9                SET PXAA(IND)=@PXADATA@("SKIN TEST",PXAK,IND)

               End DoDot:1

 +10      ;

 +11      ;Validate the data.

 +12       NEW STOP

 +13       DO VAL^PXAISKV

 +14       IF $GET(STOP)

               QUIT 

 +15      ;

SETVARA   ;Set the after visit variables.

 +1        NEW AFTER0,AFTER12,AFTER811,AFTER812

 +2        SET $PIECE(AFTER0,U,1)=$GET(PXAA("TEST"))

 +3        IF $GET(PXAA("DELETE"))

               SET $PIECE(AFTER0,U,1)="@"

 +4        SET $PIECE(AFTER0,U,2)=$GET(PATIENT)

 +5        SET $PIECE(AFTER0,U,3)=$GET(PXAVISIT)

 +6        SET $PIECE(AFTER0,U,4)=$GET(PXAA("RESULT"))

 +7        SET $PIECE(AFTER0,U,5)=$GET(PXAA("READING"))

 +8        SET $PIECE(AFTER0,U,6)=$GET(PXAA("D/T READ"))

 +9        SET $PIECE(AFTER12,U,1)=$GET(PXAA("EVENT D/T"))

 +10       SET $PIECE(AFTER12,U,4)=$GET(PXAA("ENC PROVIDER"))

 +11       SET $PIECE(AFTER811,U,1)=$GET(PXAA("COMMENT"))

 +12      ;

 +13      ;--PACKAGE AND SOURCE

 +14       SET $PIECE(AFTER812,"^",2)=$GET(PXAPKG)

 +15       SET $PIECE(AFTER812,"^",3)=$GET(PXASOURC)

 +16      ;

 +17       SET ^TMP("PXK",$JOB,"SK",PXAK,0,"AFTER")=AFTER0

 +18       SET ^TMP("PXK",$JOB,"SK",PXAK,12,"AFTER")=AFTER12

 +19       SET ^TMP("PXK",$JOB,"SK",PXAK,811,"AFTER")=AFTER811

 +20       SET ^TMP("PXK",$JOB,"SK",PXAK,812,"AFTER")=AFTER812

 +21      ;

SETVARB   ;Set the before variables.

 +1        NEW BEFOR0,BEFOR12,BEFOR811,BEFOR812

 +2        NEW IENB,PXAAX,PXBCNT,PXBKY,PXBSKY,PXBSAM

 +3        DO SK^PXBGSK(PXAVISIT)

 +4       ;

 +5        SET IENB=""

 +6        IF PXBCNT>0

               Begin DoDot:1

 +7                SET PXAAX("TEST")=$PIECE($GET(^AUTTSK(PXAA("TEST"),0)),U,1)

 +8                SET IENB=$ORDER(PXBKY(PXAAX("TEST"),IENB))

               End DoDot:1

 +9        IF $GET(IENB)

               Begin DoDot:1

 +10               SET BEFOR0=$GET(^AUPNVSK(IENB,0))

 +11               SET BEFOR12=$GET(^AUPNVSK(IENB,12))

 +12               SET BEFOR811=$GET(^AUPNVSK(IENB,811))

 +13               SET BEFOR812=$GET(^AUPNVSK(IENB,812))

               End DoDot:1

 +14      IF '$TEST

               SET (BEFOR0,BEFOR11,BEFOR12,BEFOR811,BEFOR812)=""

 +15      ;

 +16       SET ^TMP("PXK",$JOB,"SK",PXAK,0,"BEFORE")=BEFOR0

 +17       SET ^TMP("PXK",$JOB,"SK",PXAK,12,"BEFORE")=BEFOR12

 +18       SET ^TMP("PXK",$JOB,"SK",PXAK,811,"BEFORE")=BEFOR811

 +19       SET ^TMP("PXK",$JOB,"SK",PXAK,812,"BEFORE")=BEFOR812

 +20       SET ^TMP("PXK",$JOB,"SK",PXAK,"IEN")=IENB

 +21      ;

 +22       QUIT