PXAIICR ;BPFO/LMT - Set the IMM CONTRA/REFUSAL nodes ;May 28, 2021@08:56:27
;;1.0;PCE PATIENT CARE ENCOUNTER;**215,211,217**;Aug 12, 1996;Build 134
;
ICR ;Main entry point.
;
K PXAERR
S PXAERR(8)=PXAK
S PXAERR(7)="IMM CONTRA/REFUSAL"
;
N IND,PXAA
S IND=""
F S IND=$O(@PXADATA@("IMM CONTRA/REFUSAL",PXAK,IND)) Q:IND="" D
. S PXAA(IND)=@PXADATA@("IMM CONTRA/REFUSAL",PXAK,IND)
;
;Validate the data.
N STOP
D VAL^PXAIICRV
I $G(STOP) Q
;
SETVARA ;Set the after visit variables.
N AFTER0,AFTER12,AFTER811,AFTER812
;
S $P(AFTER0,U,1)=$G(PXAA("CONTRA/REFUSAL"))
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("IMMUN"))
S $P(AFTER0,U,5)=$G(PXAA("WARN UNTIL DATE"))
S $P(AFTER12,U,1)=$G(PXAA("EVENT D/T"))
S $P(AFTER12,U,4)=$G(PXAA("ENC PROVIDER"))
I $G(PXAA("CONTRA/REFUSAL"))[920.5,$G(PXAA("REFUSED VACCINE GROUP"))="" D
. S PXAA("REFUSED VACCINE GROUP")=1
S $P(AFTER12,U,5)=$G(PXAA("REFUSED VACCINE GROUP"))
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,"ICR",PXAK,0,"AFTER")=AFTER0
S ^TMP("PXK",$J,"ICR",PXAK,12,"AFTER")=AFTER12
S ^TMP("PXK",$J,"ICR",PXAK,811,"AFTER")=AFTER811
S ^TMP("PXK",$J,"ICR",PXAK,812,"AFTER")=AFTER812
;
SETVARB ;Set the before variables.
N BEFOR0,BEFOR12,BEFOR811,BEFOR812,IENB
;
S IENB=""
S IENB=$O(^AUPNVICR("AC",+$G(PXAVISIT),+$G(PXAA("IMMUN")),$G(PXAA("CONTRA/REFUSAL")),IENB))
;
I $G(IENB) D
. S BEFOR0=$G(^AUPNVICR(IENB,0))
. S BEFOR12=$G(^AUPNVICR(IENB,12))
. S BEFOR811=$G(^AUPNVICR(IENB,811))
. S BEFOR812=$G(^AUPNVICR(IENB,812))
E S (BEFOR0,BEFOR12,BEFOR811,BEFOR812)=""
;
S ^TMP("PXK",$J,"ICR",PXAK,0,"BEFORE")=BEFOR0
S ^TMP("PXK",$J,"ICR",PXAK,12,"BEFORE")=BEFOR12
S ^TMP("PXK",$J,"ICR",PXAK,811,"BEFORE")=BEFOR811
S ^TMP("PXK",$J,"ICR",PXAK,812,"BEFORE")=BEFOR812
S ^TMP("PXK",$J,"ICR",PXAK,"IEN")=IENB
;
;Package and Data Source cannot be edited.
S BEFOR812=^TMP("PXK",$J,"ICR",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,"ICR",PXAK,812,"AFTER")=AFTER812
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAIICR 2373 printed Oct 16, 2024@18:26:32 Page 2
PXAIICR ;BPFO/LMT - Set the IMM CONTRA/REFUSAL nodes ;May 28, 2021@08:56:27
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**215,211,217**;Aug 12, 1996;Build 134
+2 ;
ICR ;Main entry point.
+1 ;
+2 KILL PXAERR
+3 SET PXAERR(8)=PXAK
+4 SET PXAERR(7)="IMM CONTRA/REFUSAL"
+5 ;
+6 NEW IND,PXAA
+7 SET IND=""
+8 FOR
SET IND=$ORDER(@PXADATA@("IMM CONTRA/REFUSAL",PXAK,IND))
if IND=""
QUIT
Begin DoDot:1
+9 SET PXAA(IND)=@PXADATA@("IMM CONTRA/REFUSAL",PXAK,IND)
End DoDot:1
+10 ;
+11 ;Validate the data.
+12 NEW STOP
+13 DO VAL^PXAIICRV
+14 IF $GET(STOP)
QUIT
+15 ;
SETVARA ;Set the after visit variables.
+1 NEW AFTER0,AFTER12,AFTER811,AFTER812
+2 ;
+3 SET $PIECE(AFTER0,U,1)=$GET(PXAA("CONTRA/REFUSAL"))
+4 IF $GET(PXAA("DELETE"))
SET $PIECE(AFTER0,U,1)="@"
+5 SET $PIECE(AFTER0,U,2)=$GET(PATIENT)
+6 SET $PIECE(AFTER0,U,3)=$GET(PXAVISIT)
+7 SET $PIECE(AFTER0,U,4)=$GET(PXAA("IMMUN"))
+8 SET $PIECE(AFTER0,U,5)=$GET(PXAA("WARN UNTIL DATE"))
+9 SET $PIECE(AFTER12,U,1)=$GET(PXAA("EVENT D/T"))
+10 SET $PIECE(AFTER12,U,4)=$GET(PXAA("ENC PROVIDER"))
+11 IF $GET(PXAA("CONTRA/REFUSAL"))[920.5
IF $GET(PXAA("REFUSED VACCINE GROUP"))=""
Begin DoDot:1
+12 SET PXAA("REFUSED VACCINE GROUP")=1
End DoDot:1
+13 SET $PIECE(AFTER12,U,5)=$GET(PXAA("REFUSED VACCINE GROUP"))
+14 SET $PIECE(AFTER811,U,1)=$GET(PXAA("COMMENT"))
+15 ;
+16 ;--PACKAGE AND SOURCE
+17 SET $PIECE(AFTER812,"^",2)=$GET(PXAPKG)
+18 SET $PIECE(AFTER812,"^",3)=$GET(PXASOURC)
+19 ;
+20 SET ^TMP("PXK",$JOB,"ICR",PXAK,0,"AFTER")=AFTER0
+21 SET ^TMP("PXK",$JOB,"ICR",PXAK,12,"AFTER")=AFTER12
+22 SET ^TMP("PXK",$JOB,"ICR",PXAK,811,"AFTER")=AFTER811
+23 SET ^TMP("PXK",$JOB,"ICR",PXAK,812,"AFTER")=AFTER812
+24 ;
SETVARB ;Set the before variables.
+1 NEW BEFOR0,BEFOR12,BEFOR811,BEFOR812,IENB
+2 ;
+3 SET IENB=""
+4 SET IENB=$ORDER(^AUPNVICR("AC",+$GET(PXAVISIT),+$GET(PXAA("IMMUN")),$GET(PXAA("CONTRA/REFUSAL")),IENB))
+5 ;
+6 IF $GET(IENB)
Begin DoDot:1
+7 SET BEFOR0=$GET(^AUPNVICR(IENB,0))
+8 SET BEFOR12=$GET(^AUPNVICR(IENB,12))
+9 SET BEFOR811=$GET(^AUPNVICR(IENB,811))
+10 SET BEFOR812=$GET(^AUPNVICR(IENB,812))
End DoDot:1
+11 IF '$TEST
SET (BEFOR0,BEFOR12,BEFOR811,BEFOR812)=""
+12 ;
+13 SET ^TMP("PXK",$JOB,"ICR",PXAK,0,"BEFORE")=BEFOR0
+14 SET ^TMP("PXK",$JOB,"ICR",PXAK,12,"BEFORE")=BEFOR12
+15 SET ^TMP("PXK",$JOB,"ICR",PXAK,811,"BEFORE")=BEFOR811
+16 SET ^TMP("PXK",$JOB,"ICR",PXAK,812,"BEFORE")=BEFOR812
+17 SET ^TMP("PXK",$JOB,"ICR",PXAK,"IEN")=IENB
+18 ;
+19 ;Package and Data Source cannot be edited.
+20 SET BEFOR812=^TMP("PXK",$JOB,"ICR",PXAK,812,"BEFORE")
+21 IF BEFOR812'=""
Begin DoDot:1
+22 IF AFTER812=BEFOR812
QUIT
+23 IF $PIECE(BEFOR812,U,2)'=""
SET $PIECE(AFTER812,U,2)=$PIECE(BEFOR812,U,2)
+24 IF $PIECE(BEFOR812,U,3)'=""
SET $PIECE(AFTER812,U,3)=$PIECE(BEFOR812,U,3)
+25 SET ^TMP("PXK",$JOB,"ICR",PXAK,812,"AFTER")=AFTER812
End DoDot:1
+26 ;
+27 QUIT
