Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXAIICR

PXAIICR.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ICR ;Main entry point.
  1. ;
  1. K PXAERR
  1. S PXAERR(8)=PXAK
  1. S PXAERR(7)="IMM CONTRA/REFUSAL"
  1. ;
  1. N IND,PXAA
  1. S IND=""
  1. F S IND=$O(@PXADATA@("IMM CONTRA/REFUSAL",PXAK,IND)) Q:IND="" D
  1. . S PXAA(IND)=@PXADATA@("IMM CONTRA/REFUSAL",PXAK,IND)
  1. ;
  1. ;Validate the data.
  1. N STOP
  1. D VAL^PXAIICRV
  1. I $G(STOP) Q
  1. ;
  1. SETVARA ;Set the after visit variables.
  1. N AFTER0,AFTER12,AFTER811,AFTER812
  1. ;
  1. S $P(AFTER0,U,1)=$G(PXAA("CONTRA/REFUSAL"))
  1. I $G(PXAA("DELETE")) S $P(AFTER0,U,1)="@"
  1. S $P(AFTER0,U,2)=$G(PATIENT)
  1. S $P(AFTER0,U,3)=$G(PXAVISIT)
  1. S $P(AFTER0,U,4)=$G(PXAA("IMMUN"))
  1. S $P(AFTER0,U,5)=$G(PXAA("WARN UNTIL DATE"))
  1. S $P(AFTER12,U,1)=$G(PXAA("EVENT D/T"))
  1. S $P(AFTER12,U,4)=$G(PXAA("ENC PROVIDER"))
  1. I $G(PXAA("CONTRA/REFUSAL"))[920.5,$G(PXAA("REFUSED VACCINE GROUP"))="" D
  1. . S PXAA("REFUSED VACCINE GROUP")=1
  1. S $P(AFTER12,U,5)=$G(PXAA("REFUSED VACCINE GROUP"))
  1. S $P(AFTER811,U,1)=$G(PXAA("COMMENT"))
  1. ;
  1. ;--PACKAGE AND SOURCE
  1. S $P(AFTER812,"^",2)=$G(PXAPKG)
  1. S $P(AFTER812,"^",3)=$G(PXASOURC)
  1. ;
  1. S ^TMP("PXK",$J,"ICR",PXAK,0,"AFTER")=AFTER0
  1. S ^TMP("PXK",$J,"ICR",PXAK,12,"AFTER")=AFTER12
  1. S ^TMP("PXK",$J,"ICR",PXAK,811,"AFTER")=AFTER811
  1. S ^TMP("PXK",$J,"ICR",PXAK,812,"AFTER")=AFTER812
  1. ;
  1. SETVARB ;Set the before variables.
  1. N BEFOR0,BEFOR12,BEFOR811,BEFOR812,IENB
  1. ;
  1. S IENB=""
  1. S IENB=$O(^AUPNVICR("AC",+$G(PXAVISIT),+$G(PXAA("IMMUN")),$G(PXAA("CONTRA/REFUSAL")),IENB))
  1. ;
  1. I $G(IENB) D
  1. . S BEFOR0=$G(^AUPNVICR(IENB,0))
  1. . S BEFOR12=$G(^AUPNVICR(IENB,12))
  1. . S BEFOR811=$G(^AUPNVICR(IENB,811))
  1. . S BEFOR812=$G(^AUPNVICR(IENB,812))
  1. E S (BEFOR0,BEFOR12,BEFOR811,BEFOR812)=""
  1. ;
  1. S ^TMP("PXK",$J,"ICR",PXAK,0,"BEFORE")=BEFOR0
  1. S ^TMP("PXK",$J,"ICR",PXAK,12,"BEFORE")=BEFOR12
  1. S ^TMP("PXK",$J,"ICR",PXAK,811,"BEFORE")=BEFOR811
  1. S ^TMP("PXK",$J,"ICR",PXAK,812,"BEFORE")=BEFOR812
  1. S ^TMP("PXK",$J,"ICR",PXAK,"IEN")=IENB
  1. ;
  1. ;Package and Data Source cannot be edited.
  1. S BEFOR812=^TMP("PXK",$J,"ICR",PXAK,812,"BEFORE")
  1. I BEFOR812'="" D
  1. . I AFTER812=BEFOR812 Q
  1. . I $P(BEFOR812,U,2)'="" S $P(AFTER812,U,2)=$P(BEFOR812,U,2)
  1. . I $P(BEFOR812,U,3)'="" S $P(AFTER812,U,3)=$P(BEFOR812,U,3)
  1. . S ^TMP("PXK",$J,"ICR",PXAK,812,"AFTER")=AFTER812
  1. ;
  1. Q