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 ---[H[J[2J[HPRCAI90 1618 printed Nov 22, 2024@16:50:22 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
