- IB20P677 ;/Albany - IB*2.0*669 POST INSTALL;03/10/20 2:10pm
- ;;2.0;Integrated Billing;**677**;Mar 20, 1995;Build 17
- ;Per VA Directive 6402, this routine should not be modified.
- Q
- ;
- POSTINIT ;Post Install for IB*2.0*669
- D BMES^XPDUTL(" >> Starting the Post-Initialization routine for IB*2.0*677")
- D NEWCREAS
- D BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*677")
- Q
- ;
- NEWCREAS ; New Cancellation Reasons
- N LOOP,LIEN,IBDATA,IBCNNM
- N X,Y,DIE,DA,DR,DTOUT,DATA,IBDATAB,DIK
- ;
- N CANIEN,UPDIEN,SVCIEN,CHGIEN
- ;
- ; Grab all of the entries to update
- D MES^XPDUTL(" -> Adding new Cancellation Reason to the IB CHARGE REMOVE REASON file (350.3).")
- S Y=-1
- F LOOP=1:1 S IBDATA=$T(REASDAT+LOOP) Q:$P(IBDATA,";",3)="END" D
- . S DR=""
- . ;Extract the new ACTION TYPE to be added.
- . ;Store in array for adding to the file (#350.1).
- . Q:IBDATA="" ;go to next entry if Category is not to be updated.
- . ;
- . S IBCNNM=$P(IBDATA,";",3)
- . S LIEN=$O(^IBE(350.3,"B",IBCNNM,""))
- . ; File the update along with inactivate the ACTION TYPE
- . S DLAYGO=350.3,DIC="^IBE(350.3,",DIC(0)="L",X=IBCNNM
- . I '+LIEN D FILE^DICN S LIEN=+Y K DIC,DINUM,DLAYGO
- . S DR=".02////"_$P(IBDATA,";",4) ; ABBREVIATION
- . S DR=DR_";.03////"_$P(IBDATA,";",5) ; LIMIT
- . S DR=DR_";.04///"_$P(IBDATA,";",6) ; Can Cancel UC
- . S DR=DR_";.05////"_$P(IBDATA,";",7) ; UC Visit Processing
- . ;
- . S DIE="^IBE(350.3,",DA=LIEN
- . D ^DIE
- . ;<re-index new entry here>
- . S DA=LIEN,DIK="^IBE(350.3," D IX^DIK
- . K DR
- Q
- ;
- REASDAT ; Fee Service to inactivate
- ;;PANDEMIC RESPONSE;PR;3;Y;2
- ;;END
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P677 1643 printed Mar 13, 2025@21:09:16 Page 2
- IB20P677 ;/Albany - IB*2.0*669 POST INSTALL;03/10/20 2:10pm
- +1 ;;2.0;Integrated Billing;**677**;Mar 20, 1995;Build 17
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- POSTINIT ;Post Install for IB*2.0*669
- +1 DO BMES^XPDUTL(" >> Starting the Post-Initialization routine for IB*2.0*677")
- +2 DO NEWCREAS
- +3 DO BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*677")
- +4 QUIT
- +5 ;
- NEWCREAS ; New Cancellation Reasons
- +1 NEW LOOP,LIEN,IBDATA,IBCNNM
- +2 NEW X,Y,DIE,DA,DR,DTOUT,DATA,IBDATAB,DIK
- +3 ;
- +4 NEW CANIEN,UPDIEN,SVCIEN,CHGIEN
- +5 ;
- +6 ; Grab all of the entries to update
- +7 DO MES^XPDUTL(" -> Adding new Cancellation Reason to the IB CHARGE REMOVE REASON file (350.3).")
- +8 SET Y=-1
- +9 FOR LOOP=1:1
- SET IBDATA=$TEXT(REASDAT+LOOP)
- if $PIECE(IBDATA,";",3)="END"
- QUIT
- Begin DoDot:1
- +10 SET DR=""
- +11 ;Extract the new ACTION TYPE to be added.
- +12 ;Store in array for adding to the file (#350.1).
- +13 ;go to next entry if Category is not to be updated.
- if IBDATA=""
- QUIT
- +14 ;
- +15 SET IBCNNM=$PIECE(IBDATA,";",3)
- +16 SET LIEN=$ORDER(^IBE(350.3,"B",IBCNNM,""))
- +17 ; File the update along with inactivate the ACTION TYPE
- +18 SET DLAYGO=350.3
- SET DIC="^IBE(350.3,"
- SET DIC(0)="L"
- SET X=IBCNNM
- +19 IF '+LIEN
- DO FILE^DICN
- SET LIEN=+Y
- KILL DIC,DINUM,DLAYGO
- +20 ; ABBREVIATION
- SET DR=".02////"_$PIECE(IBDATA,";",4)
- +21 ; LIMIT
- SET DR=DR_";.03////"_$PIECE(IBDATA,";",5)
- +22 ; Can Cancel UC
- SET DR=DR_";.04///"_$PIECE(IBDATA,";",6)
- +23 ; UC Visit Processing
- SET DR=DR_";.05////"_$PIECE(IBDATA,";",7)
- +24 ;
- +25 SET DIE="^IBE(350.3,"
- SET DA=LIEN
- +26 DO ^DIE
- +27 ;<re-index new entry here>
- +28 SET DA=LIEN
- SET DIK="^IBE(350.3,"
- DO IX^DIK
- +29 KILL DR
- End DoDot:1
- +30 QUIT
- +31 ;
- REASDAT ; Fee Service to inactivate
- +1 ;;PANDEMIC RESPONSE;PR;3;Y;2
- +2 ;;END
- +3 QUIT
- +4 ;
