- 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 Feb 18, 2025@23:13:11 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)
