APCDHF.m

APCDHF ; IHS/CMI/LAB - DISPLAY HEALTH FACTORS ON HF MNEMONIC ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

HFACT ; ******************** HEALTH FACTORS * 9000019 *********

OUTPUT S APCDSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$E(Y,6,7)_""/""_(1700+$E(Y,1,3))"

 ; <SETUP>

 Q:'$D(^AUPNVHF("AC",AUPNPAT))

 W !!,"*******  PCC HEALTH FACTORS (LAST ONE FOR EACH CATEGORY) *******",!

 ; <DISPLAY>

 S APCDSFC="" F  S APCDSFC=$O(^AUTTHF("AD","C",APCDSFC)) Q:'APCDSFC  S (APCDSFT,APCDSFD)="" D ONECAT

 ; <CLEANUP>

HFACTX K APCDSCFI,APCDSDAT,APCDSDT2,APCDSFC,APCDSFD,APCDSFDP,APCDSFN,APCDSFSS,APCDSFT,APCDSFTB,APCDSHFI,APCDSHFS,APCDSHP,APCDSI,APCDSIVD,APCDSNDT,APCDSNI,APCDSPVD,APCDSSDM,APCDSSNM,APCDSTNP,Y,APCDSCVD,APCDSN

 Q

 ;

ONECAT ;

 S:APCDSFD="" APCDSFD="Y"

 S:APCDSFT="" APCDSFT=$P(^AUTTHF(APCDSFC,0),U)

 S APCDSTNP=1

 K APCDSFTB

 S APCDSCFI="" F  S APCDSCFI=$O(^AUTTHF("AC",APCDSFC,APCDSCFI)) Q:'APCDSCFI  D ONEFACT

 D DISPDATA

 Q

ONEFACT ;

 S APCDSN=^AUTTHF(APCDSCFI,0),APCDSFN=$P(APCDSN,U)

 S APCDSPVD=0

 F APCDSIVD=0:0 S APCDSIVD=$O(^AUPNVHF("AA",AUPNPAT,APCDSCFI,APCDSIVD)) Q:APCDSIVD=""  D ONEDATE

 Q

 ;

ONEDATE ;

 S Y=-APCDSIVD\1+9999999 X APCDSCVD S APCDSDAT=Y S APCDSNDT=(APCDSDAT'=APCDSPVD)

 D:APCDSTNP TPRINT

 S APCDSNI="" F  S APCDSNI=$O(^AUPNVHF("AA",AUPNPAT,APCDSCFI,APCDSIVD,APCDSNI)) Q:'APCDSNI  D SETFACT

 Q

SETFACT S APCDSN=^AUPNVHF(APCDSNI,0)

 S APCDSFSS="" S X=$P(APCDSN,U,4) I X]"" S Y=$P(^DD(9000019,.04,0),U,3) F APCDSI=1:1:$L(Y,";") S APCDSFDP=$P(Y,";",APCDSI) I X=$P(APCDSFDP,":") S APCDSFSS=$P(APCDSFDP,":",2) Q

 S APCDSFTB(APCDSIVD,APCDSDAT_U_APCDSFN_U_APCDSFSS)=""

 Q

DISPDATA ; DISPLAY TABLED DATA

 S APCDSDT2=""

 ;S APCDSIVD=0 F  S APCDSIVD=$O(APCDSFTB(APCDSIVD)) Q:'APCDSIVD  S APCDSN="" F  S APCDSN=$O(APCDSFTB(APCDSIVD,APCDSN)) Q:APCDSN=""  D DISP2

 S APCDSIVD=0 S APCDSIVD=$O(APCDSFTB(APCDSIVD)) Q:'APCDSIVD  S APCDSN="" F  S APCDSN=$O(APCDSFTB(APCDSIVD,APCDSN)) Q:APCDSN=""  D DISP2

 Q

DISP2 ;

 S APCDSDAT=$P(APCDSN,U),APCDSFN=$P(APCDSN,U,2),APCDSFSS=$P(APCDSN,U,3)

 W:APCDSDAT'=APCDSDT2 APCDSDAT W ?12,APCDSFN W:APCDSFSS]"" " (",APCDSFSS,")" W !

 S APCDSDT2=APCDSDAT

 Q

TPRINT ; PRINT TITLE

 S APCDSTNP=0

 W !,"-- ",APCDSFT," --",! ;temporary

 Q

APCDHF    ; IHS/CMI/LAB - DISPLAY HEALTH FACTORS ON HF MNEMONIC ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

HFACT     ; ******************** HEALTH FACTORS * 9000019 *********

OUTPUT     SET APCDSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$E(Y,6,7)_""/""_(1700+$E(Y,1,3))"

 +1       ; <SETUP>

 +2        IF '$DATA(^AUPNVHF("AC",AUPNPAT))

               QUIT 

 +3        WRITE !!,"*******  PCC HEALTH FACTORS (LAST ONE FOR EACH CATEGORY) *******",!

 +4       ; <DISPLAY>

 +5        SET APCDSFC=""

           FOR 

               SET APCDSFC=$ORDER(^AUTTHF("AD","C",APCDSFC))

               IF 'APCDSFC

                   QUIT 

               SET (APCDSFT,APCDSFD)=""

               DO ONECAT

 +6       ; <CLEANUP>

HFACTX     KILL APCDSCFI,APCDSDAT,APCDSDT2,APCDSFC,APCDSFD,APCDSFDP,APCDSFN,APCDSFSS,APCDSFT,APCDSFTB,APCDSHFI,APCDSHFS,APCDSHP,APCDSI,APCDSIVD,APCDSNDT,APCDSNI,APCDSPVD,APCDSSDM,APCDSSNM,APCDSTNP,Y,APCDSCVD,APCDSN

 +1        QUIT 

 +2       ;

ONECAT    ;

 +1        IF APCDSFD=""

               SET APCDSFD="Y"

 +2        IF APCDSFT=""

               SET APCDSFT=$PIECE(^AUTTHF(APCDSFC,0),U)

 +3        SET APCDSTNP=1

 +4        KILL APCDSFTB

 +5        SET APCDSCFI=""

           FOR 

               SET APCDSCFI=$ORDER(^AUTTHF("AC",APCDSFC,APCDSCFI))

               IF 'APCDSCFI

                   QUIT 

               DO ONEFACT

 +6        DO DISPDATA

 +7        QUIT 

ONEFACT   ;

 +1        SET APCDSN=^AUTTHF(APCDSCFI,0)

           SET APCDSFN=$PIECE(APCDSN,U)

 +2        SET APCDSPVD=0

 +3        FOR APCDSIVD=0:0

               SET APCDSIVD=$ORDER(^AUPNVHF("AA",AUPNPAT,APCDSCFI,APCDSIVD))

               IF APCDSIVD=""

                   QUIT 

               DO ONEDATE

 +4        QUIT 

 +5       ;

ONEDATE   ;

 +1        SET Y=-APCDSIVD\1+9999999

           XECUTE APCDSCVD

           SET APCDSDAT=Y

           SET APCDSNDT=(APCDSDAT'=APCDSPVD)

 +2        IF APCDSTNP

               DO TPRINT

 +3        SET APCDSNI=""

           FOR 

               SET APCDSNI=$ORDER(^AUPNVHF("AA",AUPNPAT,APCDSCFI,APCDSIVD,APCDSNI))

               IF 'APCDSNI

                   QUIT 

               DO SETFACT

 +4        QUIT 

SETFACT    SET APCDSN=^AUPNVHF(APCDSNI,0)

 +1        SET APCDSFSS=""

           SET X=$PIECE(APCDSN,U,4)

           IF X]""

               SET Y=$PIECE(^DD(9000019,.04,0),U,3)

               FOR APCDSI=1:1:$LENGTH(Y,";")

                   SET APCDSFDP=$PIECE(Y,";",APCDSI)

                   IF X=$PIECE(APCDSFDP,":")

                       SET APCDSFSS=$PIECE(APCDSFDP,":",2)

                       QUIT 

 +2        SET APCDSFTB(APCDSIVD,APCDSDAT_U_APCDSFN_U_APCDSFSS)=""

 +3        QUIT 

DISPDATA  ; DISPLAY TABLED DATA

 +1        SET APCDSDT2=""

 +2       ;S APCDSIVD=0 F  S APCDSIVD=$O(APCDSFTB(APCDSIVD)) Q:'APCDSIVD  S APCDSN="" F  S APCDSN=$O(APCDSFTB(APCDSIVD,APCDSN)) Q:APCDSN=""  D DISP2

 +3        SET APCDSIVD=0

           SET APCDSIVD=$ORDER(APCDSFTB(APCDSIVD))

           IF 'APCDSIVD

               QUIT 

           SET APCDSN=""

           FOR 

               SET APCDSN=$ORDER(APCDSFTB(APCDSIVD,APCDSN))

               IF APCDSN=""

                   QUIT 

               DO DISP2

 +4        QUIT 

DISP2     ;

 +1        SET APCDSDAT=$PIECE(APCDSN,U)

           SET APCDSFN=$PIECE(APCDSN,U,2)

           SET APCDSFSS=$PIECE(APCDSN,U,3)

 +2        IF APCDSDAT'=APCDSDT2

               WRITE APCDSDAT

           WRITE ?12,APCDSFN

           IF APCDSFSS]""

               WRITE " (",APCDSFSS,")"

           WRITE !

 +3        SET APCDSDT2=APCDSDAT

 +4        QUIT 

TPRINT    ; PRINT TITLE

 +1        SET APCDSTNP=0

 +2       ;temporary

           WRITE !,"-- ",APCDSFT," --",!

 +3        QUIT