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
Q
;
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 Oct 16, 2024@18:26:45 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
