IBY788PO.m

IBY788PO ;YMG/EDE - IB*2.0*788 POST INSTALL;FEB 16 2024

 ;;2.0;Integrated Billing;**788**;21-MAR-94;Build 2

 ;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*788")

 D NEWCANC

 D BMES^XPDUTL(" >>  End of the Post-Initialization routine for IB*2.0*788")

 Q

 ;

NEWCANC ; add new cancellation reason to file 350.3

 N FDA,IBCNNM

 D MES^XPDUTL("     -> Adding new Cancellation Reason to file 350.3...")

 S IBCNNM="PACT103"

 I $$FIND1^DIC(350.3,,"X",IBCNNM,"B")>0 D MES^XPDUTL("        Already exists.") Q  ; already exists

 S FDA(350.3,"+1,",.01)=IBCNNM  ; name

 S FDA(350.3,"+1,",.02)="PACT"  ; abbreviation

 S FDA(350.3,"+1,",.03)=3       ; limit

 S FDA(350.3,"+1,",.04)=1       ; can cancel UC

 S FDA(350.3,"+1,",.05)=2       ; UC visit processing

 S FDA(350.3,"+1,",.07)=2       ; MH visit processing

 S FDA(350.3,"+1,",.08)=1       ; Can cancel MH Visit

 D UPDATE^DIE("","FDA")

 D MES^XPDUTL("        Done.")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBY788PO   1049     printed  Mar 13, 2025@21:40:43                                                                                                                                                                                                    Page 2

IBY788PO  ;YMG/EDE - IB*2.0*788 POST INSTALL;FEB 16 2024

 +1       ;;2.0;Integrated Billing;**788**;21-MAR-94;Build 2

 +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*788")

 +2        DO NEWCANC

 +3        DO BMES^XPDUTL(" >>  End of the Post-Initialization routine for IB*2.0*788")

 +4        QUIT 

 +5       ;

NEWCANC   ; add new cancellation reason to file 350.3

 +1        NEW FDA,IBCNNM

 +2        DO MES^XPDUTL("     -> Adding new Cancellation Reason to file 350.3...")

 +3        SET IBCNNM="PACT103"

 +4       ; already exists

           IF $$FIND1^DIC(350.3,,"X",IBCNNM,"B")>0

               DO MES^XPDUTL("        Already exists.")

               QUIT 

 +5       ; name

           SET FDA(350.3,"+1,",.01)=IBCNNM

 +6       ; abbreviation

           SET FDA(350.3,"+1,",.02)="PACT"

 +7       ; limit

           SET FDA(350.3,"+1,",.03)=3

 +8       ; can cancel UC

           SET FDA(350.3,"+1,",.04)=1

 +9       ; UC visit processing

           SET FDA(350.3,"+1,",.05)=2

 +10      ; MH visit processing

           SET FDA(350.3,"+1,",.07)=2

 +11      ; Can cancel MH Visit

           SET FDA(350.3,"+1,",.08)=1

 +12       DO UPDATE^DIE("","FDA")

 +13       DO MES^XPDUTL("        Done.")

 +14       QUIT