Routine: PXAISK

PXAISK ;ISL/PKR - Set the SKIN TEST nodes. ;May 29, 2019@14:38:01

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**45,124,210,211,217**;Aug 12, 1996;Build 134

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,AFTER13,AFTER80,AFTER811,AFTER812 ; modified by PX*1*210

 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(AFTER0,U,7)=$G(PXAA("READER")) ; PX*1*210

 ;Do not store diagnosis as of patch PX*1*211.

 ;S $P(AFTER80,U,1)=$G(PXAA("DIAGNOSIS")) ; modified by PX*1*210

 ;S $P(AFTER80,U,2)=$G(PXAA("DIAGNOSIS 2")) ; modified by PX*1*210

 ;S $P(AFTER80,U,3)=$G(PXAA("DIAGNOSIS 3")) ; modified by PX*1*210

 ;S $P(AFTER80,U,4)=$G(PXAA("DIAGNOSIS 4")) ; modified by PX*1*210

 ;S $P(AFTER80,U,5)=$G(PXAA("DIAGNOSIS 5")) ; modified by PX*1*210

 ;S $P(AFTER80,U,6)=$G(PXAA("DIAGNOSIS 6")) ; modified by PX*1*210

 ;S $P(AFTER80,U,7)=$G(PXAA("DIAGNOSIS 7")) ; modified by PX*1*210

 ;S $P(AFTER80,U,8)=$G(PXAA("DIAGNOSIS 8")) ; modified by PX*1*210

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

 S $P(AFTER12,U,2)=$G(PXAA("ORD PROVIDER")) ; PX*1*210

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

 S $P(AFTER12,U,8)=$G(PXAA("PLACEMENT"))

 S $P(AFTER12,U,12)=$G(PXAA("ANATOMIC LOC")) ; PX*1*210

 S $P(AFTER13,U,1)=$G(PXAA("READING COMMENT")) ; PX*1*210

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

 ;--PACKAGE AND SOURCE

 S $P(AFTER812,"^",2)=$S($G(PXAA("PKG"))'="":PXAA("PKG"),1:$G(PXAPKG))

 S $P(AFTER812,"^",3)=$S($G(PXAA("SOURCE"))'="":PXAA("SOURCE"),1:$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,13,"AFTER")=AFTER13 ; PX*1*210

 ;S ^TMP("PXK",$J,"SK",PXAK,80,"AFTER")=AFTER80 ; PX*1*210

 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,BEFOR13,BEFOR80,BEFOR811,BEFOR812 ; modified by PX*1*210

 N IENB

 S IENB=$$GETIEN(PXAVISIT,PXAA("TEST"))

 I $G(IENB) D

 . ; if placement skin test pointer is the current entry, no need to store it

 . I IENB=$G(PXAA("PLACEMENT")) S $P(^TMP("PXK",$J,"SK",PXAK,12,"AFTER"),U,8)=""

. ;

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

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

 . S BEFOR13=$G(^AUPNVSK(IENB,13)) ; PX*1*210

 . S BEFOR80=$G(^AUPNVSK(IENB,80)) ; PX*1*210

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

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

 E  S (BEFOR0,BEFOR11,BEFOR12,BEFOR13,BEFOR80,BEFOR811,BEFOR812)="" ; modified by PX*1*210

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

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

 S ^TMP("PXK",$J,"SK",PXAK,13,"BEFORE")=BEFOR13 ; PX*1*210

 S ^TMP("PXK",$J,"SK",PXAK,80,"BEFORE")=BEFOR80 ; PX*1*210

 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

 ;Package and Data Source cannot be edited.

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

 I BEFOR812'="" D

 . I AFTER812=BEFOR812 Q

 . I $P(BEFOR812,U,2)'="" S $P(AFTER812,U,2)=$P(BEFOR812,U,2)

 . I $P(BEFOR812,U,3)'="" S $P(AFTER812,U,3)=$P(BEFOR812,U,3)

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

GETIEN(PXAVISIT,PXASK) ;

 N PXAIEN,PXASKNM,PXBCNT,PXBKY,PXBSKY,PXBSAM

 S PXAIEN=""

 D SK^PXBGSK(PXAVISIT)

 I PXBCNT>0 D

 . S PXASKNM=$P($G(^AUTTSK(PXASK,0)),U,1)

 . S PXAIEN=$O(PXBKY(PXASKNM,PXAIEN))

 Q PXAIEN

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAISK   3912     printed  Feb 18, 2025@23:52:20                                                                                                                                                                                                      Page 2

PXAISK    ;ISL/PKR - Set the SKIN TEST nodes. ;May 29, 2019@14:38:01

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**45,124,210,211,217**;Aug 12, 1996;Build 134

 +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       ; modified by PX*1*210

           NEW AFTER0,AFTER12,AFTER13,AFTER80,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       ; PX*1*210

           SET $PIECE(AFTER0,U,7)=$GET(PXAA("READER"))

 +10      ;Do not store diagnosis as of patch PX*1*211.

 +11      ;S $P(AFTER80,U,1)=$G(PXAA("DIAGNOSIS")) ; modified by PX*1*210

 +12      ;S $P(AFTER80,U,2)=$G(PXAA("DIAGNOSIS 2")) ; modified by PX*1*210

 +13      ;S $P(AFTER80,U,3)=$G(PXAA("DIAGNOSIS 3")) ; modified by PX*1*210

 +14      ;S $P(AFTER80,U,4)=$G(PXAA("DIAGNOSIS 4")) ; modified by PX*1*210

 +15      ;S $P(AFTER80,U,5)=$G(PXAA("DIAGNOSIS 5")) ; modified by PX*1*210

 +16      ;S $P(AFTER80,U,6)=$G(PXAA("DIAGNOSIS 6")) ; modified by PX*1*210

 +17      ;S $P(AFTER80,U,7)=$G(PXAA("DIAGNOSIS 7")) ; modified by PX*1*210

 +18      ;S $P(AFTER80,U,8)=$G(PXAA("DIAGNOSIS 8")) ; modified by PX*1*210

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

 +20      ; PX*1*210

           SET $PIECE(AFTER12,U,2)=$GET(PXAA("ORD PROVIDER"))

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

 +22       SET $PIECE(AFTER12,U,8)=$GET(PXAA("PLACEMENT"))

 +23      ; PX*1*210

           SET $PIECE(AFTER12,U,12)=$GET(PXAA("ANATOMIC LOC"))

 +24      ; PX*1*210

           SET $PIECE(AFTER13,U,1)=$GET(PXAA("READING COMMENT"))

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

 +26      ;

 +27      ;--PACKAGE AND SOURCE

 +28       SET $PIECE(AFTER812,"^",2)=$SELECT($GET(PXAA("PKG"))'="":PXAA("PKG"),1:$GET(PXAPKG))

 +29       SET $PIECE(AFTER812,"^",3)=$SELECT($GET(PXAA("SOURCE"))'="":PXAA("SOURCE"),1:$GET(PXASOURC))

 +30      ;

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

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

 +33      ; PX*1*210

           SET ^TMP("PXK",$JOB,"SK",PXAK,13,"AFTER")=AFTER13

 +34      ;S ^TMP("PXK",$J,"SK",PXAK,80,"AFTER")=AFTER80 ; PX*1*210

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

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

 +37      ;

SETVARB   ;Set the before variables.

 +1       ; modified by PX*1*210

           NEW BEFOR0,BEFOR12,BEFOR13,BEFOR80,BEFOR811,BEFOR812

 +2        NEW IENB

 +3       ;

 +4        SET IENB=$$GETIEN(PXAVISIT,PXAA("TEST"))

 +5       ;

 +6        IF $GET(IENB)

               Begin DoDot:1

 +7       ; if placement skin test pointer is the current entry, no need to store it

 +8                IF IENB=$GET(PXAA("PLACEMENT"))

                       SET $PIECE(^TMP("PXK",$JOB,"SK",PXAK,12,"AFTER"),U,8)=""

 +9       ;

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

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

 +12      ; PX*1*210

                   SET BEFOR13=$GET(^AUPNVSK(IENB,13))

 +13      ; PX*1*210

                   SET BEFOR80=$GET(^AUPNVSK(IENB,80))

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

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

               End DoDot:1

 +16      ; modified by PX*1*210

          IF '$TEST

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

 +17      ;

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

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

 +20      ; PX*1*210

           SET ^TMP("PXK",$JOB,"SK",PXAK,13,"BEFORE")=BEFOR13

 +21      ; PX*1*210

           SET ^TMP("PXK",$JOB,"SK",PXAK,80,"BEFORE")=BEFOR80

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

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

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

 +25      ;

 +26      ;Package and Data Source cannot be edited.

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

 +28       IF BEFOR812'=""

               Begin DoDot:1

 +29               IF AFTER812=BEFOR812

                       QUIT

 +30               IF $PIECE(BEFOR812,U,2)'=""

                       SET $PIECE(AFTER812,U,2)=$PIECE(BEFOR812,U,2)

 +31               IF $PIECE(BEFOR812,U,3)'=""

                       SET $PIECE(AFTER812,U,3)=$PIECE(BEFOR812,U,3)

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

               End DoDot:1

 +33       QUIT

 +34      ;

GETIEN(PXAVISIT,PXASK) ;

 +1       ;

 +2        NEW PXAIEN,PXASKNM,PXBCNT,PXBKY,PXBSKY,PXBSAM

 +3       ;

 +4        SET PXAIEN=""

 +5       ;

 +6        DO SK^PXBGSK(PXAVISIT)

 +7        IF PXBCNT>0

               Begin DoDot:1

 +8                SET PXASKNM=$PIECE($GET(^AUTTSK(PXASK,0)),U,1)

 +9                SET PXAIEN=$ORDER(PXBKY(PXASKNM,PXAIEN))

               End DoDot:1

 +10      ;

 +11       QUIT PXAIEN

PXAISK.m