- 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 Feb 19, 2025@00:01:51 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