IBY784PO ;YMG/EDE - IB*2.0*784 POST INSTALL;DEC 07 2023
;;2.0;Integrated Billing;**784**;21-MAR-94;Build 8
;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ; entry point
D BMES^XPDUTL(" >> Starting the Post-Initialization routine for IB*2.0*784")
D SETPARAM
D NEWCANC
D UPDCANC
D INITMH
D BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*784")
Q
;
SETPARAM ; populate fields 350.9/71.03 and 350.9/71.04
N FDA
D MES^XPDUTL(" -> Initializing IB Site Parameters...")
S FDA(350.9,"1,",71.03)=3230627 ; Cleland-Dole effective date
S FDA(350.9,"1,",71.04)=3271229 ; Cleland-Dole end date
D FILE^DIE("","FDA")
D MES^XPDUTL(" Done.")
Q
;
NEWCANC ; add new cancellation reason to file 350.3
N FDA,IBCNNM,IBDATA,IBREAS,IENS,Z
D MES^XPDUTL(" -> Adding new Cancellation Reasons to file 350.3...")
F Z=1:1 S IBDATA=$T(REASDAT1+Z),IBCNNM=$P(IBDATA,";",3) Q:IBCNNM="END" D
.S IBREAS=+$$FIND1^DIC(350.3,,"X",IBCNNM,"B"),IENS=$S(IBREAS>0:IBREAS_",",1:"+1,")
.S FDA(350.3,IENS,.01)=IBCNNM ; name
.S FDA(350.3,IENS,.02)=$P(IBDATA,";",4) ; abbreviation
.S FDA(350.3,IENS,.03)=$P(IBDATA,";",5) ; limit
.S FDA(350.3,IENS,.04)=$P(IBDATA,";",6) ; can cancel UC
.S FDA(350.3,IENS,.05)=$P(IBDATA,";",7) ; UC visit processing
.S FDA(350.3,IENS,.07)=$P(IBDATA,";",8) ; MH visit processing
.S FDA(350.3,IENS,.08)=$P(IBDATA,";",9) ; Can cancel MH Visit
.I IBREAS D FILE^DIE("","FDA")
.I 'IBREAS D UPDATE^DIE("","FDA")
.K FDA
D MES^XPDUTL(" Done.")
Q
;
UPDCANC ; update field .07 in file 350.3
N FDA,IBCNNM,IBDATA,IBIEN,IBMH,IENS,Z
D MES^XPDUTL(" -> initializing MH Visit Processing and Can Cancel MH Visit fields in file 350.3...")
F Z=1:1 S IBDATA=$T(REASDAT+Z),IBCNNM=$P(IBDATA,";",3) Q:IBCNNM="END" D
.S IBMH=$P(IBDATA,";",4)
.S IBIEN=$O(^IBE(350.3,"B",IBCNNM,""))
.I 'IBIEN D Q
..D BMES^XPDUTL(" >> Unable to update the Charge Remove Reason "_IBCNNM_".")
..D MES^XPDUTL(" >> Please set the MH VISIT PROCESSING FIELD to "_$$EXTERNAL^DILFD(350.3,.07,,IBMH)_" and the CAN CANCEL MH VISIT field to Yes")
..Q
.S IENS=IBIEN_","
.S FDA(350.3,IENS,.07)=IBMH
.S FDA(350.3,IENS,.08)=1
.D FILE^DIE("","FDA") K FDA
.Q
D MES^XPDUTL(" Done.")
Q
;
INITMH ; initialize file 351.83
N IBEDT,IBSDT
D MES^XPDUTL(" -> Populating IB MH VISIT TRACKING file...")
S IBSDT=$$GET1^DIQ(350.9,"1,",71.03,"I"),IBEDT=$$GET1^DIQ(350.9,"1,",71.04,"I")
D MHVST^IBMHUT1(IBSDT,IBEDT)
D MES^XPDUTL(" Done.")
Q
;
REASDAT ; Cancellation reasons (350.3) to update
;;ADJUDICATED AS CATEGORY A;2
;;AGENT ORANGE RELATED;2
;;BILLED AT HIGHER TIER RATE;2
;;BILLED LTC CHARGE;2
;;CANCER OF HEAD/NECK;2
;;CATASTROPHICALLY DISABLED;2
;;CHANGE IN ELIGIBILITY;2
;;CHECK OUT DELETED;1
;;CLASS II DENTAL VISIT;2
;;CLASSIFICATION CHANGED;2
;;COMBAT VETERAN;3
;;COMP & PENSION VISIT RECORDED;1
;;COMPACT;3
;;DUPLICATE;4
;;ELIGIBILITY INCORRECT;2
;;ENTERED IN ERROR;1
;;EXEMPT:SCREENING;1
;;HARDSHIP GRANTED;2
;;HRFS FLAGGED;3
;;INDIAN ATTESTATION;2
;;INSURANCE CO PAID IN FULL;2
;;IONIZING RAD RELATED;2
;;KATRINA AFFECTED VETERAN;1
;;MEDAL OF HONOR;1
;;MILITARY SEXUAL TRAUMA;3
;;MT CHARGE EDITED;1
;;MT OP APPT CANCELLED;1
;;MT OP APPT NO-SHOW;1
;;MT STATUS CHANGED FROM YES;2
;;PANDEMIC RESPONSE;2
;;PATIENT DECEASED;2
;;PROJECT 112/SHAD;2
;;PURPLE HEART CONFIRMED;1
;;RECD INPATIENT CARE;2
;;REGISTRY EXAM;1
;;RESEARCH VISIT/ADMISSION;2
;;SERVICE CONNECTED VISIT/ADM;1
;;SOUTHWEST ASIA RELATED;2
;;TREATED AT OTHER FACILITY;2
;;END
Q
;
REASDAT1 ; New cancellation reasons (350.3)
;;CLELAND-DOLE;C-D;3;1;2;3;1
;;HANNON ACT;HAN;3;1;2;2;1
;;WORLD WAR II;WWII;3;1;2;2;1
;;LEGAL;LG;3;1;2;2;1
;;END
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY784PO 3861 printed Apr 09, 2024@21:05:45 Page 2
IBY784PO ;YMG/EDE - IB*2.0*784 POST INSTALL;DEC 07 2023
+1 ;;2.0;Integrated Billing;**784**;21-MAR-94;Build 8
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; entry point
+1 DO BMES^XPDUTL(" >> Starting the Post-Initialization routine for IB*2.0*784")
+2 DO SETPARAM
+3 DO NEWCANC
+4 DO UPDCANC
+5 DO INITMH
+6 DO BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*784")
+7 QUIT
+8 ;
SETPARAM ; populate fields 350.9/71.03 and 350.9/71.04
+1 NEW FDA
+2 DO MES^XPDUTL(" -> Initializing IB Site Parameters...")
+3 ; Cleland-Dole effective date
SET FDA(350.9,"1,",71.03)=3230627
+4 ; Cleland-Dole end date
SET FDA(350.9,"1,",71.04)=3271229
+5 DO FILE^DIE("","FDA")
+6 DO MES^XPDUTL(" Done.")
+7 QUIT
+8 ;
NEWCANC ; add new cancellation reason to file 350.3
+1 NEW FDA,IBCNNM,IBDATA,IBREAS,IENS,Z
+2 DO MES^XPDUTL(" -> Adding new Cancellation Reasons to file 350.3...")
+3 FOR Z=1:1
SET IBDATA=$TEXT(REASDAT1+Z)
SET IBCNNM=$PIECE(IBDATA,";",3)
if IBCNNM="END"
QUIT
Begin DoDot:1
+4 SET IBREAS=+$$FIND1^DIC(350.3,,"X",IBCNNM,"B")
SET IENS=$SELECT(IBREAS>0:IBREAS_",",1:"+1,")
+5 ; name
SET FDA(350.3,IENS,.01)=IBCNNM
+6 ; abbreviation
SET FDA(350.3,IENS,.02)=$PIECE(IBDATA,";",4)
+7 ; limit
SET FDA(350.3,IENS,.03)=$PIECE(IBDATA,";",5)
+8 ; can cancel UC
SET FDA(350.3,IENS,.04)=$PIECE(IBDATA,";",6)
+9 ; UC visit processing
SET FDA(350.3,IENS,.05)=$PIECE(IBDATA,";",7)
+10 ; MH visit processing
SET FDA(350.3,IENS,.07)=$PIECE(IBDATA,";",8)
+11 ; Can cancel MH Visit
SET FDA(350.3,IENS,.08)=$PIECE(IBDATA,";",9)
+12 IF IBREAS
DO FILE^DIE("","FDA")
+13 IF 'IBREAS
DO UPDATE^DIE("","FDA")
+14 KILL FDA
End DoDot:1
+15 DO MES^XPDUTL(" Done.")
+16 QUIT
+17 ;
UPDCANC ; update field .07 in file 350.3
+1 NEW FDA,IBCNNM,IBDATA,IBIEN,IBMH,IENS,Z
+2 DO MES^XPDUTL(" -> initializing MH Visit Processing and Can Cancel MH Visit fields in file 350.3...")
+3 FOR Z=1:1
SET IBDATA=$TEXT(REASDAT+Z)
SET IBCNNM=$PIECE(IBDATA,";",3)
if IBCNNM="END"
QUIT
Begin DoDot:1
+4 SET IBMH=$PIECE(IBDATA,";",4)
+5 SET IBIEN=$ORDER(^IBE(350.3,"B",IBCNNM,""))
+6 IF 'IBIEN
Begin DoDot:2
+7 DO BMES^XPDUTL(" >> Unable to update the Charge Remove Reason "_IBCNNM_".")
+8 DO MES^XPDUTL(" >> Please set the MH VISIT PROCESSING FIELD to "_$$EXTERNAL^DILFD(350.3,.07,,IBMH)_" and the CAN CANCEL MH VISIT field to Yes")
+9 QUIT
End DoDot:2
QUIT
+10 SET IENS=IBIEN_","
+11 SET FDA(350.3,IENS,.07)=IBMH
+12 SET FDA(350.3,IENS,.08)=1
+13 DO FILE^DIE("","FDA")
KILL FDA
+14 QUIT
End DoDot:1
+15 DO MES^XPDUTL(" Done.")
+16 QUIT
+17 ;
INITMH ; initialize file 351.83
+1 NEW IBEDT,IBSDT
+2 DO MES^XPDUTL(" -> Populating IB MH VISIT TRACKING file...")
+3 SET IBSDT=$$GET1^DIQ(350.9,"1,",71.03,"I")
SET IBEDT=$$GET1^DIQ(350.9,"1,",71.04,"I")
+4 DO MHVST^IBMHUT1(IBSDT,IBEDT)
+5 DO MES^XPDUTL(" Done.")
+6 QUIT
+7 ;
REASDAT ; Cancellation reasons (350.3) to update
+1 ;;ADJUDICATED AS CATEGORY A;2
+2 ;;AGENT ORANGE RELATED;2
+3 ;;BILLED AT HIGHER TIER RATE;2
+4 ;;BILLED LTC CHARGE;2
+5 ;;CANCER OF HEAD/NECK;2
+6 ;;CATASTROPHICALLY DISABLED;2
+7 ;;CHANGE IN ELIGIBILITY;2
+8 ;;CHECK OUT DELETED;1
+9 ;;CLASS II DENTAL VISIT;2
+10 ;;CLASSIFICATION CHANGED;2
+11 ;;COMBAT VETERAN;3
+12 ;;COMP & PENSION VISIT RECORDED;1
+13 ;;COMPACT;3
+14 ;;DUPLICATE;4
+15 ;;ELIGIBILITY INCORRECT;2
+16 ;;ENTERED IN ERROR;1
+17 ;;EXEMPT:SCREENING;1
+18 ;;HARDSHIP GRANTED;2
+19 ;;HRFS FLAGGED;3
+20 ;;INDIAN ATTESTATION;2
+21 ;;INSURANCE CO PAID IN FULL;2
+22 ;;IONIZING RAD RELATED;2
+23 ;;KATRINA AFFECTED VETERAN;1
+24 ;;MEDAL OF HONOR;1
+25 ;;MILITARY SEXUAL TRAUMA;3
+26 ;;MT CHARGE EDITED;1
+27 ;;MT OP APPT CANCELLED;1
+28 ;;MT OP APPT NO-SHOW;1
+29 ;;MT STATUS CHANGED FROM YES;2
+30 ;;PANDEMIC RESPONSE;2
+31 ;;PATIENT DECEASED;2
+32 ;;PROJECT 112/SHAD;2
+33 ;;PURPLE HEART CONFIRMED;1
+34 ;;RECD INPATIENT CARE;2
+35 ;;REGISTRY EXAM;1
+36 ;;RESEARCH VISIT/ADMISSION;2
+37 ;;SERVICE CONNECTED VISIT/ADM;1
+38 ;;SOUTHWEST ASIA RELATED;2
+39 ;;TREATED AT OTHER FACILITY;2
+40 ;;END
+41 QUIT
+42 ;
REASDAT1 ; New cancellation reasons (350.3)
+1 ;;CLELAND-DOLE;C-D;3;1;2;3;1
+2 ;;HANNON ACT;HAN;3;1;2;2;1
+3 ;;WORLD WAR II;WWII;3;1;2;2;1
+4 ;;LEGAL;LG;3;1;2;2;1
+5 ;;END
+6 QUIT
