IB20P449 ;ELZ/OAK - POST INIT FOR PATCH;02/22/2011
;;2.0;INTEGRATED BILLING;**449**;21-MAR-94;Build 15
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;
ENV ;
; setup so no queue of install
S XPDNOQUE=1
Q
;
POST ; post init entry point
;
D MES^XPDUTL(" Starting post-init for IB*2.0*449")
;
D 3542
D 3503
D REPORT
;
D MES^XPDUTL(" Finished post-init for IB*2.0*449")
;
Q
;
3542 ; add entry to exemption file 354.2 if not there
I $O(^IBE(354.2,"B","CATASTROPHICALLY DISABLED",0)) D Q
. D MES^XPDUTL(" - CATASTROPHICALLY DISABLED already exists, nothing to add to 354.2.")
;
N DO,X,Y,DIC
;
S X="CATASTROPHICALLY DISABLED",DIC="^IBE(354.2,",DIC(0)=""
S DIC("DR")=".02///Patient is Catastrophically Disabled;.03///1;.04///1;.05///100"
D FILE^DICN
;
D MES^XPDUTL($S(Y>1:" - CATASTROPHICALLY DISABLED Exemption Reason (#354.2) added.",1:"*** ERROR: COULD NOT CREATE NEW CD ENTRY IN 354.2 ***"))
;
Q
;
3503 ; add entry to Charge Removal Reason file if not there
;
N IBX,DO,DIC,X,Y
;
D MES^XPDUTL(" - Adding entry to Charge Removal Reason (#350.3) file.")
S IBX="CATASTROPHICALLY DISABLED^CD" D
. K DO S DIC="^IBE(350.3,",DIC(0)="",X=$P(IBX,"^")
. S DIC("DR")=".02///^S X=$P(IBX,U,2);.03///3"
. I $O(^IBE(350.3,"B",X,0)) D MES^XPDUTL(" - "_X_" already exists.") Q
. D FILE^DICN
. D MES^XPDUTL($S(Y>1:" - "_$P(IBX,"^")_" entry added.",1:"*** ERROR: COULD NOT CREATE NEW "_$P(IBX,"^",2)_" ENTRY IN 350.3 ***"))
;
D MES^XPDUTL(" - Done adding entry in Charge Removal Reason (#350.3) file.")
Q
;
REPORT ; - this will produce a report of patient's with charges that are CD.
;
N POP,%ZIS,ZTRTN,ZTDESC,ZTSK,IBA,IBEDT,IBBDT,ZTSAVE
S IBBDT=3100504,IBEDT=DT
S IBA(1)="Select the device for the Catastrophically Disabled Charge report. It"
S IBA(2)="should be queued to a printer off hours as it can take some time to run"
S IBA(3)="with at least a margin of 132 columns."
D MES^XPDUTL(.IBA)
S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) D Q
.S ZTRTN="DQ^IBOCDRPT",ZTDESC="Catastrophically Disabled Copay Report"
.S (ZTSAVE("IBEDT"),ZTSAVE("IBBDT"))=""
.D ^%ZTLOAD D HOME^%ZIS K IO("Q")
.D MES^XPDUTL("Catastrophically Disabled Copay Report queued #"_ZTSK)
D DQ^IBOCDRPT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P449 2324 printed Apr 09, 2024@21:14:04 Page 2
IB20P449 ;ELZ/OAK - POST INIT FOR PATCH;02/22/2011
+1 ;;2.0;INTEGRATED BILLING;**449**;21-MAR-94;Build 15
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
ENV ;
+1 ; setup so no queue of install
+2 SET XPDNOQUE=1
+3 QUIT
+4 ;
POST ; post init entry point
+1 ;
+2 DO MES^XPDUTL(" Starting post-init for IB*2.0*449")
+3 ;
+4 DO 3542
+5 DO 3503
+6 DO REPORT
+7 ;
+8 DO MES^XPDUTL(" Finished post-init for IB*2.0*449")
+9 ;
+10 QUIT
+11 ;
3542 ; add entry to exemption file 354.2 if not there
+1 IF $ORDER(^IBE(354.2,"B","CATASTROPHICALLY DISABLED",0))
Begin DoDot:1
+2 DO MES^XPDUTL(" - CATASTROPHICALLY DISABLED already exists, nothing to add to 354.2.")
End DoDot:1
QUIT
+3 ;
+4 NEW DO,X,Y,DIC
+5 ;
+6 SET X="CATASTROPHICALLY DISABLED"
SET DIC="^IBE(354.2,"
SET DIC(0)=""
+7 SET DIC("DR")=".02///Patient is Catastrophically Disabled;.03///1;.04///1;.05///100"
+8 DO FILE^DICN
+9 ;
+10 DO MES^XPDUTL($SELECT(Y>1:" - CATASTROPHICALLY DISABLED Exemption Reason (#354.2) added.",1:"*** ERROR: COULD NOT CREATE NEW CD ENTRY IN 354.2 ***"))
+11 ;
+12 QUIT
+13 ;
3503 ; add entry to Charge Removal Reason file if not there
+1 ;
+2 NEW IBX,DO,DIC,X,Y
+3 ;
+4 DO MES^XPDUTL(" - Adding entry to Charge Removal Reason (#350.3) file.")
+5 SET IBX="CATASTROPHICALLY DISABLED^CD"
Begin DoDot:1
+6 KILL DO
SET DIC="^IBE(350.3,"
SET DIC(0)=""
SET X=$PIECE(IBX,"^")
+7 SET DIC("DR")=".02///^S X=$P(IBX,U,2);.03///3"
+8 IF $ORDER(^IBE(350.3,"B",X,0))
DO MES^XPDUTL(" - "_X_" already exists.")
QUIT
+9 DO FILE^DICN
+10 DO MES^XPDUTL($SELECT(Y>1:" - "_$PIECE(IBX,"^")_" entry added.",1:"*** ERROR: COULD NOT CREATE NEW "_$PIECE(IBX,"^",2)_" ENTRY IN 350.3 ***"))
End DoDot:1
+11 ;
+12 DO MES^XPDUTL(" - Done adding entry in Charge Removal Reason (#350.3) file.")
+13 QUIT
+14 ;
REPORT ; - this will produce a report of patient's with charges that are CD.
+1 ;
+2 NEW POP,%ZIS,ZTRTN,ZTDESC,ZTSK,IBA,IBEDT,IBBDT,ZTSAVE
+3 SET IBBDT=3100504
SET IBEDT=DT
+4 SET IBA(1)="Select the device for the Catastrophically Disabled Charge report. It"
+5 SET IBA(2)="should be queued to a printer off hours as it can take some time to run"
+6 SET IBA(3)="with at least a margin of 132 columns."
+7 DO MES^XPDUTL(.IBA)
+8 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+9 IF $DATA(IO("Q"))
Begin DoDot:1
+10 SET ZTRTN="DQ^IBOCDRPT"
SET ZTDESC="Catastrophically Disabled Copay Report"
+11 SET (ZTSAVE("IBEDT"),ZTSAVE("IBBDT"))=""
+12 DO ^%ZTLOAD
DO HOME^%ZIS
KILL IO("Q")
+13 DO MES^XPDUTL("Catastrophically Disabled Copay Report queued #"_ZTSK)
End DoDot:1
QUIT
+14 DO DQ^IBOCDRPT
+15 QUIT
