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)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMOBJ 5437 printed Oct 16, 2024@17:47:40 Page 2
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(^DIC(11,+$PIECE($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)
