- 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 Jan 18, 2025@03:26:50 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