PRCAI90.m

PRCAI90 ;WISC/RFJ-patch 90 post init ;1 Oct 97

 ;;4.5;Accounts Receivable;**90**;Mar 20, 1995

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

 ;

 ;

 ;  start of post init for patch 90

 ;  change the following AR categories in file 430.2 from non-accrued

 ;  to accrued.  hard code the sets since the field is un-editable.

 ;    INELIGIBLE HOSP. (cat# 20)

 ;    TORT FEASOR (cat# 22)

 ;    EMERGENCY/HUMANITARIAN (cat# 25)

 ;

 N %,CATEGORY,D,D0,D,DA,DATA,DD,DI,DIC,DIE,DINUM,DO,DLAYGO,DQ,DR,PRCADESC,PRCARSC,X,Y

 F CATEGORY=20,22,25 D

 .   S DA=+$O(^PRCA(430.2,"AC",CATEGORY,0))

 .   S DATA=$G(^PRCA(430.2,DA,0)) I DATA="" Q

 .   S $P(^PRCA(430.2,DA,0),"^",9)=1

 ;

 ;  add new server entry into file 423.5

 I '$O(^PRCF(423.5,"B","CTL-TRI",0)) D

 .   S X="CTL-TRI",DIC="^PRCF(423.5,",DIC(0)="L",DLAYGO=432.5

 .   K DD,DO D FILE^DICN

 .   I Y<0 W !!,"ERROR SETTING UP THE SERVER IN FILE 423.5.  PLEASE RE-INSTALL THE PATCH." Q

 .   S DA=+Y

 .   S DIE="^PRCF(423.5,",DR="2////EN;3////RCXFMSTR;1///FMS"

 .   D ^DIE

 ;

 ;  add revenue source codes to file 347.3

 F PRCARSC=8000,8022,8033,8034,8035 D

 .   I $D(^RC(347.3,PRCARSC,0)) Q

 .   S (DINUM,X)=PRCARSC,DIC="^RC(347.3,",DIC(0)="L",DLAYGO=347.3

 .   S PRCADESC=$S(PRCARSC=8000:"NON MEDICAL REIMBURSEMENTS",PRCARSC=8022:"Q&S - WOC",PRCARSC=8033:"TORT FEASOR - TITLE 38",PRCARSC=8034:"ENHANCED USE LEASE",PRCARSC=8035:"SHARING MED RESOURCES, A/O",1:"")

 .   S DIC("DR")=".02////"_PRCADESC_";"

 .   K DD,DO D FILE^DICN

 .   I Y<0 W !!,"ERROR ADDING REVENUE SOURCE CODES IN FILE 347.3.  PLEASE RE-INSTALL PATCH."

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCAI90   1618     printed  Apr 09, 2024@20:48:33                                                                                                                                                                                                     Page 2

PRCAI90   ;WISC/RFJ-patch 90 post init ;1 Oct 97

 +1       ;;4.5;Accounts Receivable;**90**;Mar 20, 1995

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

 +3       ;

 +4       ;

 +5       ;  start of post init for patch 90

 +6       ;  change the following AR categories in file 430.2 from non-accrued

 +7       ;  to accrued.  hard code the sets since the field is un-editable.

 +8       ;    INELIGIBLE HOSP. (cat# 20)

 +9       ;    TORT FEASOR (cat# 22)

 +10      ;    EMERGENCY/HUMANITARIAN (cat# 25)

 +11      ;

 +12       NEW %,CATEGORY,D,D0,D,DA,DATA,DD,DI,DIC,DIE,DINUM,DO,DLAYGO,DQ,DR,PRCADESC,PRCARSC,X,Y

 +13       FOR CATEGORY=20,22,25

               Begin DoDot:1

 +14               SET DA=+$ORDER(^PRCA(430.2,"AC",CATEGORY,0))

 +15               SET DATA=$GET(^PRCA(430.2,DA,0))

                   IF DATA=""

                       QUIT 

 +16               SET $PIECE(^PRCA(430.2,DA,0),"^",9)=1

               End DoDot:1

 +17      ;

 +18      ;  add new server entry into file 423.5

 +19       IF '$ORDER(^PRCF(423.5,"B","CTL-TRI",0))

               Begin DoDot:1

 +20               SET X="CTL-TRI"

                   SET DIC="^PRCF(423.5,"

                   SET DIC(0)="L"

                   SET DLAYGO=432.5

 +21               KILL DD,DO

                   DO FILE^DICN

 +22               IF Y<0

                       WRITE !!,"ERROR SETTING UP THE SERVER IN FILE 423.5.  PLEASE RE-INSTALL THE PATCH."

                       QUIT 

 +23               SET DA=+Y

 +24               SET DIE="^PRCF(423.5,"

                   SET DR="2////EN;3////RCXFMSTR;1///FMS"

 +25               DO ^DIE

               End DoDot:1

 +26      ;

 +27      ;  add revenue source codes to file 347.3

 +28       FOR PRCARSC=8000,8022,8033,8034,8035

               Begin DoDot:1

 +29               IF $DATA(^RC(347.3,PRCARSC,0))

                       QUIT 

 +30               SET (DINUM,X)=PRCARSC

                   SET DIC="^RC(347.3,"

                   SET DIC(0)="L"

                   SET DLAYGO=347.3

 +31               SET PRCADESC=$SELECT(PRCARSC=8000:"NON MEDICAL REIMBURSEMENTS",PRCARSC=8022:"Q&S - WOC",PRCARSC=8033:"TORT FEASOR - TITLE 38",PRCARSC=8034:"ENHANCED USE LEASE",PRCARSC=8035:"SHARING MED RESOURCES, A/O",1:"")

 +32               SET DIC("DR")=".02////"_PRCADESC_";"

 +33               KILL DD,DO

                   DO FILE^DICN

 +34               IF Y<0

                       WRITE !!,"ERROR ADDING REVENUE SOURCE CODES IN FILE 347.3.  PLEASE RE-INSTALL PATCH."

               End DoDot:1

 +35       QUIT