PRCA280.m

PRCA280 ;ALB/CXW - POST INIT, Type of Care correction; 14-SEP-2011

 ;;4.5;Accounts Receivable;**280**;Mar 20, 1995;Build 12

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

 ;

POST ; 

 D MSG("    PRCA*4.5*280 Post-Install .....")

 D UPACT

 D MSG("    PRCA*4.5*280 Post-Install Complete")

 D MSG("")

 Q

 ;

UPACT ;Update to Type of Care #15.1 in file #430

 N IBI,IBDG,IBAT,IBAIEN,IBCEN,IBNCC,PRCAX,PRCATC,PRCACNT,DIE,DA,DR,X

 S IBNCC="HOSPITAL CARE (NSC)"

 S IBCEN=$O(^PRCA(430.2,"B",IBNCC,0))

 I 'IBCEN D MSG(">>> "_IBNCC_" not defined on file #430.2, no update on file #430") Q

 ; update if patient charges in these type events

 S IBDG="^DG FEE SERVICE (INPT) CANCEL^DG FEE SERVICE (INPT) NEW^DG FEE SERVICE (INPT) UPDATE^"

 ;

 D MSG(">>> Updating Type of Care to file #430...")

 S IBI="",PRCACNT=0

 F  S IBI=$O(^IB("ABIL",IBI)) Q:IBI=""  D

 . S IBAIEN=$O(^IB("ABIL",IBI,0)) Q:'IBAIEN

 . S IBAT=$P($G(^IB(IBAIEN,0)),"^",3) Q:'IBAT

 . S IBAT=$P(^IBE(350.1,IBAT,0),"^")

 . ; no update if none of 3 dg fee service (inpt)

 . I '$F(IBDG,"^"_IBAT_"^") Q

 . S PRCAX=$O(^PRCA(430,"B",IBI,0)) Q:'PRCAX

 . S PRCATC=$P(^PRCA(430,PRCAX,0),"^",16)

 . ; no update if exists or null

 . I ('PRCATC)!(PRCATC=IBCEN) Q

 . S PRCATC=$P(^PRCA(430.2,PRCATC,0),"^")

 . S DA=+PRCAX,DIE="^PRCA(430,",DR="15.1///"_IBCEN D ^DIE K DA,DIE,DR

 . D MSG(" >> "_PRCATC_" on "_IBI_" changed to "_IBNCC)

 . S PRCACNT=PRCACNT+1

 D MSG(">>> The type of care on total "_PRCACNT_$S(PRCACNT=1:" bill has",1:" bills have")_" been updated")

 Q

 ;

MSG(X) ;

 D MES^XPDUTL(X)

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCA280   1602     printed  Apr 09, 2024@20:53:15                                                                                                                                                                                                     Page 2

PRCA280   ;ALB/CXW - POST INIT, Type of Care correction; 14-SEP-2011

 +1       ;;4.5;Accounts Receivable;**280**;Mar 20, 1995;Build 12

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        QUIT 

 +4       ;

POST      ; 

 +1        DO MSG("    PRCA*4.5*280 Post-Install .....")

 +2        DO UPACT

 +3        DO MSG("    PRCA*4.5*280 Post-Install Complete")

 +4        DO MSG("")

 +5        QUIT 

 +6       ;

UPACT     ;Update to Type of Care #15.1 in file #430

 +1        NEW IBI,IBDG,IBAT,IBAIEN,IBCEN,IBNCC,PRCAX,PRCATC,PRCACNT,DIE,DA,DR,X

 +2        SET IBNCC="HOSPITAL CARE (NSC)"

 +3        SET IBCEN=$ORDER(^PRCA(430.2,"B",IBNCC,0))

 +4        IF 'IBCEN

               DO MSG(">>> "_IBNCC_" not defined on file #430.2, no update on file #430")

               QUIT 

 +5       ; update if patient charges in these type events

 +6        SET IBDG="^DG FEE SERVICE (INPT) CANCEL^DG FEE SERVICE (INPT) NEW^DG FEE SERVICE (INPT) UPDATE^"

 +7       ;

 +8        DO MSG(">>> Updating Type of Care to file #430...")

 +9        SET IBI=""

           SET PRCACNT=0

 +10       FOR 

               SET IBI=$ORDER(^IB("ABIL",IBI))

               if IBI=""

                   QUIT 

               Begin DoDot:1

 +11               SET IBAIEN=$ORDER(^IB("ABIL",IBI,0))

                   if 'IBAIEN

                       QUIT 

 +12               SET IBAT=$PIECE($GET(^IB(IBAIEN,0)),"^",3)

                   if 'IBAT

                       QUIT 

 +13               SET IBAT=$PIECE(^IBE(350.1,IBAT,0),"^")

 +14      ; no update if none of 3 dg fee service (inpt)

 +15               IF '$FIND(IBDG,"^"_IBAT_"^")

                       QUIT 

 +16               SET PRCAX=$ORDER(^PRCA(430,"B",IBI,0))

                   if 'PRCAX

                       QUIT 

 +17               SET PRCATC=$PIECE(^PRCA(430,PRCAX,0),"^",16)

 +18      ; no update if exists or null

 +19               IF ('PRCATC)!(PRCATC=IBCEN)

                       QUIT 

 +20               SET PRCATC=$PIECE(^PRCA(430.2,PRCATC,0),"^")

 +21               SET DA=+PRCAX

                   SET DIE="^PRCA(430,"

                   SET DR="15.1///"_IBCEN

                   DO ^DIE

                   KILL DA,DIE,DR

 +22               DO MSG(" >> "_PRCATC_" on "_IBI_" changed to "_IBNCC)

 +23               SET PRCACNT=PRCACNT+1

               End DoDot:1

 +24       DO MSG(">>> The type of care on total "_PRCACNT_$SELECT(PRCACNT=1:" bill has",1:" bills have")_" been updated")

 +25       QUIT 

 +26      ;

MSG(X)    ;

 +1        DO MES^XPDUTL(X)

 +2        QUIT 

 +3       ;