IBY757PO ;YMG/EDE - IB*2.0*757 POST INSTALL;APR 23 2024
;;2.0;Integrated Billing;**757**;21-MAR-94;Build 4
;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*757")
D NEWCANC
D BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*757")
Q
;
NEWCANC ; add new cancellation reasons 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(REASDAT+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
;
REASDAT ; New cancellation reasons (350.3)
;;FITTING/ADJUSTMENT;F/A;3
;;PATIENT NOT SEEN;PNS;3;1;1;1;1
;;TEST ACCOUNT;TEST;3;1;1;1;1
;;INELIGIBLE;INEL;3;1;1;1;1
;;ACTIVE DUTY;AD;3;;;1;1
;;CAMP LEJEUNE;CL;3;;;2;1
;;VACCINE;VAC;3
;;OBSERVATION STAY;OS;3;1;2;2;1
;;TELEPHONE ENCOUNTER;TE;3;;;2;1
;;END
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY757PO 1554 printed Dec 13, 2024@02:35:22 Page 2
IBY757PO ;YMG/EDE - IB*2.0*757 POST INSTALL;APR 23 2024
+1 ;;2.0;Integrated Billing;**757**;21-MAR-94;Build 4
+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*757")
+2 DO NEWCANC
+3 DO BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*757")
+4 QUIT
+5 ;
NEWCANC ; add new cancellation reasons 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(REASDAT+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 ;
REASDAT ; New cancellation reasons (350.3)
+1 ;;FITTING/ADJUSTMENT;F/A;3
+2 ;;PATIENT NOT SEEN;PNS;3;1;1;1;1
+3 ;;TEST ACCOUNT;TEST;3;1;1;1;1
+4 ;;INELIGIBLE;INEL;3;1;1;1;1
+5 ;;ACTIVE DUTY;AD;3;;;1;1
+6 ;;CAMP LEJEUNE;CL;3;;;2;1
+7 ;;VACCINE;VAC;3
+8 ;;OBSERVATION STAY;OS;3;1;2;2;1
+9 ;;TELEPHONE ENCOUNTER;TE;3;;;2;1
+10 ;;END
+11 QUIT
