- PXAIHF ;ISL/PKR - Set the HEALTH FACTOR nodes. ;12/18/97
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**45**;Aug 12, 1996
- ;
- HF ;Main entry point.
- ;
- K PXAERR
- S PXAERR(8)=PXAK
- S PXAERR(7)="HEALTH FACTOR"
- ;
- N IND,PXAA
- S IND=""
- F S IND=$O(@PXADATA@("HEALTH FACTOR",PXAK,IND)) Q:IND="" D
- . S PXAA(IND)=@PXADATA@("HEALTH FACTOR",PXAK,IND)
- ;
- ;Validate the data.
- N STOP
- D VAL^PXAIHFV
- I $G(STOP) Q
- ;
- SETVARA ;Set the after visit variables.
- N AFTER0,AFTER12,AFTER811,AFTER812
- S $P(AFTER0,U,1)=$G(PXAA("HEALTH FACTOR"))
- 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("LEVEL/SEVERITY"))
- S $P(AFTER12,U,1)=$G(PXAA("EVENT D/T"))
- S $P(AFTER12,U,4)=$G(PXAA("ENC PROVIDER"))
- 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,"HF",PXAK,0,"AFTER")=AFTER0
- S ^TMP("PXK",$J,"HF",PXAK,12,"AFTER")=AFTER12
- S ^TMP("PXK",$J,"HF",PXAK,811,"AFTER")=AFTER811
- S ^TMP("PXK",$J,"HF",PXAK,812,"AFTER")=AFTER812
- ;
- SETVARB ;Set the before variables.
- N BEFOR0,BEFOR12,BEFOR811,BEFOR812
- N IENB,PXAAX,PXBCNT,PXBKY,PXBSKY,PXBSAM
- D HF^PXBGHF(PXAVISIT)
- ;
- S IENB=""
- I PXBCNT>0 D
- . S PXAAX("HEALTH FACTOR")=$P($G(^AUTTHF(PXAA("HEALTH FACTOR"),0)),U,1)
- . S IENB=$O(PXBKY(PXAAX("HEALTH FACTOR"),IENB))
- I $G(IENB) D
- . S BEFOR0=$G(^AUPNVHF(IENB,0))
- . S BEFOR12=$G(^AUPNVHF(IENB,12))
- . S BEFOR811=$G(^AUPNVHF(IENB,811))
- . S BEFOR812=$G(^AUPNVHF(IENB,812))
- E S (BEFOR0,BEFOR11,BEFOR12,BEFOR811,BEFOR812)=""
- ;
- S ^TMP("PXK",$J,"HF",PXAK,0,"BEFORE")=BEFOR0
- S ^TMP("PXK",$J,"HF",PXAK,12,"BEFORE")=BEFOR12
- S ^TMP("PXK",$J,"HF",PXAK,811,"BEFORE")=BEFOR811
- S ^TMP("PXK",$J,"HF",PXAK,812,"BEFORE")=BEFOR812
- S ^TMP("PXK",$J,"HF",PXAK,"IEN")=IENB
- ;
- Q
- PXAIHF ;ISL/PKR - Set the HEALTH FACTOR nodes. ;12/18/97
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**45**;Aug 12, 1996
- +2 ;
- HF ;Main entry point.
- +1 ;
- +2 KILL PXAERR
- +3 SET PXAERR(8)=PXAK
- +4 SET PXAERR(7)="HEALTH FACTOR"
- +5 ;
- +6 NEW IND,PXAA
- +7 SET IND=""
- +8 FOR
- SET IND=$ORDER(@PXADATA@("HEALTH FACTOR",PXAK,IND))
- IF IND=""
- QUIT
- Begin DoDot:1
- +9 SET PXAA(IND)=@PXADATA@("HEALTH FACTOR",PXAK,IND)
- End DoDot:1
- +10 ;
- +11 ;Validate the data.
- +12 NEW STOP
- +13 DO VAL^PXAIHFV
- +14 IF $GET(STOP)
- QUIT
- +15 ;
- SETVARA ;Set the after visit variables.
- +1 NEW AFTER0,AFTER12,AFTER811,AFTER812
- +2 SET $PIECE(AFTER0,U,1)=$GET(PXAA("HEALTH FACTOR"))
- +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("LEVEL/SEVERITY"))
- +7 SET $PIECE(AFTER12,U,1)=$GET(PXAA("EVENT D/T"))
- +8 SET $PIECE(AFTER12,U,4)=$GET(PXAA("ENC PROVIDER"))
- +9 SET $PIECE(AFTER811,U,1)=$GET(PXAA("COMMENT"))
- +10 ;
- +11 ;--PACKAGE AND SOURCE
- +12 SET $PIECE(AFTER812,"^",2)=$GET(PXAPKG)
- +13 SET $PIECE(AFTER812,"^",3)=$GET(PXASOURC)
- +14 ;
- +15 SET ^TMP("PXK",$JOB,"HF",PXAK,0,"AFTER")=AFTER0
- +16 SET ^TMP("PXK",$JOB,"HF",PXAK,12,"AFTER")=AFTER12
- +17 SET ^TMP("PXK",$JOB,"HF",PXAK,811,"AFTER")=AFTER811
- +18 SET ^TMP("PXK",$JOB,"HF",PXAK,812,"AFTER")=AFTER812
- +19 ;
- SETVARB ;Set the before variables.
- +1 NEW BEFOR0,BEFOR12,BEFOR811,BEFOR812
- +2 NEW IENB,PXAAX,PXBCNT,PXBKY,PXBSKY,PXBSAM
- +3 DO HF^PXBGHF(PXAVISIT)
- +4 ;
- +5 SET IENB=""
- +6 IF PXBCNT>0
- Begin DoDot:1
- +7 SET PXAAX("HEALTH FACTOR")=$PIECE($GET(^AUTTHF(PXAA("HEALTH FACTOR"),0)),U,1)
- +8 SET IENB=$ORDER(PXBKY(PXAAX("HEALTH FACTOR"),IENB))
- End DoDot:1
- +9 IF $GET(IENB)
- Begin DoDot:1
- +10 SET BEFOR0=$GET(^AUPNVHF(IENB,0))
- +11 SET BEFOR12=$GET(^AUPNVHF(IENB,12))
- +12 SET BEFOR811=$GET(^AUPNVHF(IENB,811))
- +13 SET BEFOR812=$GET(^AUPNVHF(IENB,812))
- End DoDot:1
- +14 IF '$TEST
- SET (BEFOR0,BEFOR11,BEFOR12,BEFOR811,BEFOR812)=""
- +15 ;
- +16 SET ^TMP("PXK",$JOB,"HF",PXAK,0,"BEFORE")=BEFOR0
- +17 SET ^TMP("PXK",$JOB,"HF",PXAK,12,"BEFORE")=BEFOR12
- +18 SET ^TMP("PXK",$JOB,"HF",PXAK,811,"BEFORE")=BEFOR811
- +19 SET ^TMP("PXK",$JOB,"HF",PXAK,812,"BEFORE")=BEFOR812
- +20 SET ^TMP("PXK",$JOB,"HF",PXAK,"IEN")=IENB
- +21 ;
- +22 QUIT
