PXRMOBJ.m

PXRMOBJ ;SLC/JVS - PXRM OBJECT AND GUI EVAL FOR GEC ;7/14/05  07:34

 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21

 ;

 Q

 ;

STAT(DFN) ;Status Object

 N STATUS,CNT,I,MISSING,CMARRAY,K

 S CNT=0

 D STATUS^PXRMOBJX(DFN,.STATUS,.MISSING)

 K ^TMP("PXRMOBJSTATUS",$J)

 S CMARRAY="^TMP(""PXRMOBJSTATUS"",$J)"

 S I=0 F  S I=$O(STATUS(I)) Q:I=""  D

 .S K=0 F  S K=$O(STATUS(I,K)) Q:K=""  D

 ..S ^TMP("PXRMOBJSTATUS",$J,$$UP,0)=STATUS(I,K)

 S ^TMP("PXRMOBJSTATUS",$J,$$UP,0)=""

 Q "~@"_$NA(@CMARRAY)

 ;

UP() ;

 S CNT=CNT+1

 Q CNT

 ;

DEM(DFN) ;

 Q:DFN=""

 N X,ARY

 N ZIP,DATA

 D GET

 K ^TMP("PXRMOBJ",$J)

 S CMARRAY="^TMP(""PXRMOBJ"",$J)"

 S ^TMP("PXRMOBJ",$J,1,0)=""

 S ^TMP("PXRMOBJ",$J,2,0)="                 Name: "_DATA("NAME")_"  "_"Gender: "_DATA("SEX")

 S ^TMP("PXRMOBJ",$J,3,0)="                  DOB: "_DATA("DOB")_"  "_"Age:"_DATA("AGE")

 S ^TMP("PXRMOBJ",$J,4,0)="       Marital Status: "_DATA("MARSTAT")

 S ^TMP("PXRMOBJ",$J,5,0)="              Address: "_DATA("STRAD1")

 I DATA("STRAD2")'="" S ^TMP("PXRMOBJ",$J,6,0)="                       "_DATA("STRAD2")

 I DATA("STRAD3")'="" S ^TMP("PXRMOBJ",$J,7,0)="                       "_DATA("STRAD3")

 S ^TMP("PXRMOBJ",$J,8,0)="                       "_DATA("CITY")_" "_DATA("STATE")_" "_ZIP

 S ^TMP("PXRMOBJ",$J,9,0)="              H Phone: "_DATA("PHONER")

 S ^TMP("PXRMOBJ",$J,10,0)="              W Phone: "_DATA("PHONEW")

 S ^TMP("PXRMOBJ",$J,11,0)="  Service Connected %: "_DATA("SERCON")

 S ^TMP("PXRMOBJ",$J,12,0)="    LTC Co-Pay Status: "_DATA("STATUS")

 I DATA("STATUS DATE")'["<No Test>" D

 .S ^TMP("PXRMOBJ",$J,13,0)="      LTC Date Tested: "_DATA("STATUS DATE")

 I $D(DATA("WHY")) D

 .S ^TMP("PXRMOBJ",$J,13,0)="               Reason: "_DATA("WHY")

 S ^TMP("PXRMOBJ",$J,14,0)=""

 ; NODE MUST END WITH ZERO SUBSCRIPT

 ; @CMARRAY@(CNT,0)=TEXT

 D EXIT

 Q "~@"_$NA(@CMARRAY)

 ;

GET ; Get data from file

 N FIELDS,STATUS,DFN2,STAT

 ;DBIA #11

 ;S DFN=75

 S FIELDS=".01;.02;.03;.033;.05;.111;.1112;.112;.113;.114;.115;.116;.131;.132;.302;.3621;.3622;.3624;.3626;.3627;.3628;.3629;.36295"

 D GETS^DIQ(2,DFN,FIELDS,"ER","^TMP(""PXRMGECOBJ"",$J)")

 ;

 S ARY="^TMP(""PXRMGECOBJ"",$J,2)",DFN2=DFN_","

 ;

 S DATA("AGE")=@ARY@(DFN2,"AGE","E")

 S DATA("AMOUNTAA")=@ARY@(DFN2,"AMOUNT OF AID & ATTENDANCE","E")

 S DATA("AMOUNTGI")=@ARY@(DFN2,"AMOUNT OF GI INSURANCE","E")

 S DATA("AMOUNTHO")=@ARY@(DFN2,"AMOUNT OF HOUSEBOUND","E")

 S DATA("AMOUNTOT")=@ARY@(DFN2,"AMOUNT OF OTHER INCOME","E")

 S DATA("AMOUNTOR")=@ARY@(DFN2,"AMOUNT OF OTHER RETIREMENT","E")

 S DATA("AMOUNTSS")=@ARY@(DFN2,"AMOUNT OF SSI","E")

 S DATA("AMOUNTVA")=@ARY@(DFN2,"AMOUNT OF VA PENSION","E")

 S DATA("CITY")=@ARY@(DFN2,"CITY","E")

 S DATA("DOB")=@ARY@(DFN2,"DATE OF BIRTH","E")

 S DATA("MARSTAT")=@ARY@(DFN2,"MARITAL STATUS","E")

 S DATA("NAME")=@ARY@(DFN2,"NAME","E")

 S DATA("PHONER")=@ARY@(DFN2,"PHONE NUMBER [RESIDENCE]","E")

 S DATA("PHONEW")=@ARY@(DFN2,"PHONE NUMBER [WORK]","E")

 S DATA("SERCON")=@ARY@(DFN2,"SERVICE CONNECTED PERCENTAGE","E")

 S DATA("SEX")=@ARY@(DFN2,"SEX","E")

 S DATA("STATE")=@ARY@(DFN2,"STATE","E")

 S DATA("STRAD1")=@ARY@(DFN2,"STREET ADDRESS [LINE 1]","E")

 S DATA("STRAD2")=@ARY@(DFN2,"STREET ADDRESS [LINE 2]","E")

 S DATA("STRAD3")=@ARY@(DFN2,"STREET ADDRESS [LINE 3]","E")

 S DATA("TOTAL")=@ARY@(DFN2,"TOTAL ANNUAL VA CHECK AMOUNT","E")

 S DATA("ZIP")=@ARY@(DFN2,"ZIP CODE","E")

 S DATA("ZIP4")=@ARY@(DFN2,"ZIP+4","E")

 S ZIP="" D

 .I DATA("ZIP4")'="" S ZIP=DATA("ZIP4") Q

 .I DATA("ZIP")'="" S ZIP=DATA("ZIP")

 S DATA("SUM")=DATA("AMOUNTAA")+DATA("AMOUNTGI")+DATA("AMOUNTHO")+DATA("AMOUNTOT")+DATA("AMOUNTSS")+DATA("AMOUNTVA")

 I DATA("SUM")=0 S DATA("SUM")=""

 ;get LTC CO-PAY TEST status

 S (DATA("STATUS"),DATA("STATUS DATE"))="<No Test>"

 S STAT=$$EXMPT(DFN)

 I STAT=0 S DATA("STATUS")="NON EXEMPT"

 I STAT>0 S DATA("STATUS")="EXEMPT"

 I STAT=1 S DATA("WHY")="Veteran has compensable SC disability."

 I STAT=2 S DATA("WHY")="Veteran is single NSC pensioner."

 ;DBIA #701

 S STATUS=$$LST^EASECU(DFN,"",3) D

 .I STATUS'="" D

 ..S DATA("STATUS")=$P(STATUS,"^",3)

 ..S DATA("STATUS DATE")=$$FMTE^XLFDT($P(STATUS,"^",2))

 Q

 ;

EXMPT(DFN) ;Check if veteran is exempt from LTC co-payments:

 ; If the veteran has a compensable SC disability, OR

 ; If the veteran is a single, NSC pensioner not in receipt of A&A

 ; and HB benefits

 ;   Input   -- DFN  Patient IEN

 ;   Output  -- 0 = veteran not exempt

 ;              1 = veteran has compensable SC disability

 ;              2 = veteran is single NSC pensioner (no A&A, HB)

 N X,Y,ELG

 S Y=0

 ; if service connected percentage is greater than 10% OR service

 ; connected percentage is less than 10% and annual VA

 ; check amount is greater than 0, then exempt type 1

 S X=$G(^DPT(DFN,.36)),ELG=$P($G(^DIC(8,+X,0)),U,9)

 I ELG=1!($P($G(^DPT(DFN,.3)),U,2)'<10) S Y=1 G EXMPTQ

 I ELG=3,$P($G(^DPT(DFN,.3)),U,2)<10,$P($G(^DPT(DFN,.362)),U,20)>0 S Y=1

 G EXMPTQ

 ; if Service Connected quit

 I $P($G(^DPT(DFN,.3)),U)="Y" G EXMPTQ

 ; if Marital Status = 'Married' or 'Separated' quit

 S X=$P($G(^DIC(11,+$P($G(^DPT(DFN,0)),U,5),0)),U,3)

 I "^M^S^"[("^"_X_"^") G EXMPTQ

 ; if not receiving VA pension quit

 S X=$G(^DPT(DFN,.362)) I $P(X,U,14)'="Y" G EXMPTQ

 ; if receiving A&A or HP benefits quit

 I $P(X,U,12)="Y"!($P(X,U,13)="Y") G EXMPTQ

 S Y=2

EXMPTQ Q Y

        ;

EXIT ;

 K ^TMP("PXRMGECOBJ",$J)

PXRMOBJ   ;SLC/JVS - PXRM OBJECT AND GUI EVAL FOR GEC ;7/14/05  07:34

 +1       ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21

 +2       ;

 +3        QUIT 

 +4       ;

STAT(DFN) ;Status Object

 +1        NEW STATUS,CNT,I,MISSING,CMARRAY,K

 +2        SET CNT=0

 +3        DO STATUS^PXRMOBJX(DFN,.STATUS,.MISSING)

 +4        KILL ^TMP("PXRMOBJSTATUS",$JOB)

 +5        SET CMARRAY="^TMP(""PXRMOBJSTATUS"",$J)"

 +6        SET I=0

           FOR 

               SET I=$ORDER(STATUS(I))

               IF I=""

                   QUIT 

               Begin DoDot:1

 +7                SET K=0

                   FOR 

                       SET K=$ORDER(STATUS(I,K))

                       IF K=""

                           QUIT 

                       Begin DoDot:2

 +8                        SET ^TMP("PXRMOBJSTATUS",$JOB,$$UP,0)=STATUS(I,K)

                       End DoDot:2

               End DoDot:1

 +9        SET ^TMP("PXRMOBJSTATUS",$JOB,$$UP,0)=""

 +10       QUIT "~@"_$NAME(@CMARRAY)

 +11      ;

UP()      ;

 +1        SET CNT=CNT+1

 +2        QUIT CNT

 +3       ;

DEM(DFN)  ;

 +1        IF DFN=""

               QUIT 

 +2        NEW X,ARY

 +3        NEW ZIP,DATA

 +4        DO GET

 +5        KILL ^TMP("PXRMOBJ",$JOB)

 +6        SET CMARRAY="^TMP(""PXRMOBJ"",$J)"

 +7        SET ^TMP("PXRMOBJ",$JOB,1,0)=""

 +8        SET ^TMP("PXRMOBJ",$JOB,2,0)="                 Name: "_DATA("NAME")_"  "_"Gender: "_DATA("SEX")

 +9        SET ^TMP("PXRMOBJ",$JOB,3,0)="                  DOB: "_DATA("DOB")_"  "_"Age:"_DATA("AGE")

 +10       SET ^TMP("PXRMOBJ",$JOB,4,0)="       Marital Status: "_DATA("MARSTAT")

 +11       SET ^TMP("PXRMOBJ",$JOB,5,0)="              Address: "_DATA("STRAD1")

 +12       IF DATA("STRAD2")'=""

               SET ^TMP("PXRMOBJ",$JOB,6,0)="                       "_DATA("STRAD2")

 +13       IF DATA("STRAD3")'=""

               SET ^TMP("PXRMOBJ",$JOB,7,0)="                       "_DATA("STRAD3")

 +14       SET ^TMP("PXRMOBJ",$JOB,8,0)="                       "_DATA("CITY")_" "_DATA("STATE")_" "_ZIP

 +15       SET ^TMP("PXRMOBJ",$JOB,9,0)="              H Phone: "_DATA("PHONER")

 +16       SET ^TMP("PXRMOBJ",$JOB,10,0)="              W Phone: "_DATA("PHONEW")

 +17       SET ^TMP("PXRMOBJ",$JOB,11,0)="  Service Connected %: "_DATA("SERCON")

 +18       SET ^TMP("PXRMOBJ",$JOB,12,0)="    LTC Co-Pay Status: "_DATA("STATUS")

 +19       IF DATA("STATUS DATE")'["<No Test>"

               Begin DoDot:1

 +20               SET ^TMP("PXRMOBJ",$JOB,13,0)="      LTC Date Tested: "_DATA("STATUS DATE")

               End DoDot:1

 +21       IF $DATA(DATA("WHY"))

               Begin DoDot:1

 +22               SET ^TMP("PXRMOBJ",$JOB,13,0)="               Reason: "_DATA("WHY")

               End DoDot:1

 +23       SET ^TMP("PXRMOBJ",$JOB,14,0)=""

 +24      ; NODE MUST END WITH ZERO SUBSCRIPT

 +25      ; @CMARRAY@(CNT,0)=TEXT

 +26       DO EXIT

 +27       QUIT "~@"_$NAME(@CMARRAY)

 +28      ;

GET       ; Get data from file

 +1        NEW FIELDS,STATUS,DFN2,STAT

 +2       ;DBIA #11

 +3       ;S DFN=75

 +4        SET FIELDS=".01;.02;.03;.033;.05;.111;.1112;.112;.113;.114;.115;.116;.131;.132;.302;.3621;.3622;.3624;.3626;.3627;.3628;.3629;.36295"

 +5        DO GETS^DIQ(2,DFN,FIELDS,"ER","^TMP(""PXRMGECOBJ"",$J)")

 +6       ;

 +7        SET ARY="^TMP(""PXRMGECOBJ"",$J,2)"

           SET DFN2=DFN_","

 +8       ;

 +9        SET DATA("AGE")=@ARY@(DFN2,"AGE","E")

 +10       SET DATA("AMOUNTAA")=@ARY@(DFN2,"AMOUNT OF AID & ATTENDANCE","E")

 +11       SET DATA("AMOUNTGI")=@ARY@(DFN2,"AMOUNT OF GI INSURANCE","E")

 +12       SET DATA("AMOUNTHO")=@ARY@(DFN2,"AMOUNT OF HOUSEBOUND","E")

 +13       SET DATA("AMOUNTOT")=@ARY@(DFN2,"AMOUNT OF OTHER INCOME","E")

 +14       SET DATA("AMOUNTOR")=@ARY@(DFN2,"AMOUNT OF OTHER RETIREMENT","E")

 +15       SET DATA("AMOUNTSS")=@ARY@(DFN2,"AMOUNT OF SSI","E")

 +16       SET DATA("AMOUNTVA")=@ARY@(DFN2,"AMOUNT OF VA PENSION","E")

 +17       SET DATA("CITY")=@ARY@(DFN2,"CITY","E")

 +18       SET DATA("DOB")=@ARY@(DFN2,"DATE OF BIRTH","E")

 +19       SET DATA("MARSTAT")=@ARY@(DFN2,"MARITAL STATUS","E")

 +20       SET DATA("NAME")=@ARY@(DFN2,"NAME","E")

 +21       SET DATA("PHONER")=@ARY@(DFN2,"PHONE NUMBER [RESIDENCE]","E")

 +22       SET DATA("PHONEW")=@ARY@(DFN2,"PHONE NUMBER [WORK]","E")

 +23       SET DATA("SERCON")=@ARY@(DFN2,"SERVICE CONNECTED PERCENTAGE","E")

 +24       SET DATA("SEX")=@ARY@(DFN2,"SEX","E")

 +25       SET DATA("STATE")=@ARY@(DFN2,"STATE","E")

 +26       SET DATA("STRAD1")=@ARY@(DFN2,"STREET ADDRESS [LINE 1]","E")

 +27       SET DATA("STRAD2")=@ARY@(DFN2,"STREET ADDRESS [LINE 2]","E")

 +28       SET DATA("STRAD3")=@ARY@(DFN2,"STREET ADDRESS [LINE 3]","E")

 +29       SET DATA("TOTAL")=@ARY@(DFN2,"TOTAL ANNUAL VA CHECK AMOUNT","E")

 +30       SET DATA("ZIP")=@ARY@(DFN2,"ZIP CODE","E")

 +31       SET DATA("ZIP4")=@ARY@(DFN2,"ZIP+4","E")

 +32       SET ZIP=""

           Begin DoDot:1

 +33           IF DATA("ZIP4")'=""

                   SET ZIP=DATA("ZIP4")

                   QUIT 

 +34           IF DATA("ZIP")'=""

                   SET ZIP=DATA("ZIP")

           End DoDot:1

 +35       SET DATA("SUM")=DATA("AMOUNTAA")+DATA("AMOUNTGI")+DATA("AMOUNTHO")+DATA("AMOUNTOT")+DATA("AMOUNTSS")+DATA("AMOUNTVA")

 +36       IF DATA("SUM")=0

               SET DATA("SUM")=""

 +37      ;get LTC CO-PAY TEST status

 +38       SET (DATA("STATUS"),DATA("STATUS DATE"))="<No Test>"

 +39       SET STAT=$$EXMPT(DFN)

 +40       IF STAT=0

               SET DATA("STATUS")="NON EXEMPT"

 +41       IF STAT>0

               SET DATA("STATUS")="EXEMPT"

 +42       IF STAT=1

               SET DATA("WHY")="Veteran has compensable SC disability."

 +43       IF STAT=2

               SET DATA("WHY")="Veteran is single NSC pensioner."

 +44      ;DBIA #701

 +45       SET STATUS=$$LST^EASECU(DFN,"",3)

           Begin DoDot:1

 +46           IF STATUS'=""

                   Begin DoDot:2

 +47                   SET DATA("STATUS")=$PIECE(STATUS,"^",3)

 +48                   SET DATA("STATUS DATE")=$$FMTE^XLFDT($PIECE(STATUS,"^",2))

                   End DoDot:2

           End DoDot:1

 +49       QUIT 

 +50      ;

EXMPT(DFN) ;Check if veteran is exempt from LTC co-payments:

 +1       ; If the veteran has a compensable SC disability, OR

 +2       ; If the veteran is a single, NSC pensioner not in receipt of A&A

 +3       ; and HB benefits

 +4       ;   Input   -- DFN  Patient IEN

 +5       ;   Output  -- 0 = veteran not exempt

 +6       ;              1 = veteran has compensable SC disability

 +7       ;              2 = veteran is single NSC pensioner (no A&A, HB)

 +8        NEW X,Y,ELG

 +9        SET Y=0

 +10      ; if service connected percentage is greater than 10% OR service

 +11      ; connected percentage is less than 10% and annual VA

 +12      ; check amount is greater than 0, then exempt type 1

 +13       SET X=$GET(^DPT(DFN,.36))

           SET ELG=$PIECE($GET(^DIC(8,+X,0)),U,9)

 +14       IF ELG=1!($PIECE($GET(^DPT(DFN,.3)),U,2)'<10)

               SET Y=1

               GOTO EXMPTQ

 +15       IF ELG=3

               IF $PIECE($GET(^DPT(DFN,.3)),U,2)<10

                   IF $PIECE($GET(^DPT(DFN,.362)),U,20)>0

                       SET Y=1

 +16       GOTO EXMPTQ

 +17      ; if Service Connected quit

 +18       IF $PIECE($GET(^DPT(DFN,.3)),U)="Y"

               GOTO EXMPTQ

 +19      ; if Marital Status = 'Married' or 'Separated' quit

 +20       SET X=$PIECE($GET">GET(^DIC(11,+$PIECE($GET">GET(^DPT(DFN,0)),U,5),0)),U,3)

 +21       IF "^M^S^"[("^"_X_"^")

               GOTO EXMPTQ

 +22      ; if not receiving VA pension quit

 +23       SET X=$GET(^DPT(DFN,.362))

           IF $PIECE(X,U,14)'="Y"

               GOTO EXMPTQ

 +24      ; if receiving A&A or HP benefits quit

 +25       IF $PIECE(X,U,12)="Y"!($PIECE(X,U,13)="Y")

               GOTO EXMPTQ

 +26       SET Y=2

EXMPTQ     QUIT Y

 +1       ;

EXIT      ;

 +1        KILL ^TMP("PXRMGECOBJ",$JOB)