PRCAI176 ;WOIFO/AAT-POST-INSTALL ROUTINE PATCH PRCA*4.5*176 ;08-Feb-02
;;4.5;Accounts Receivable;**176**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;;
Q
;
DATA ;;Only "CATEGORY NUMBER" (piece 8 here) are to be changed in the file!
;;33^ADULT DAY HEALTH CARE^AD^0^1319^^P^40^2^1^1^1^1^2^30,40,55,80,85,50,60,65,70
;;34^DOMICILIARY^DO^0^1319^^P^41^2^1^1^1^1^2^30,40,55,80,85,50,60,65,70
;;35^RESPITE CARE-INSTITUTIONAL^RC^0^1319^^P^42^2^1^1^1^1^2^30,40,55,80,85,50,60,65,70
;;36^RESPITE CARE-NON-INSTITUTIONAL^RN^0^1319^^P^43^2^1^1^1^1^2^30,40,55,80,85,50,60,65,70
;;37^GERIATRIC EVAL-INSTITUTIONAL^GE^0^1319^^P^44^2^1^1^1^1^2^30,40,55,80,85,50,60,65,70
;;38^GERIATRIC EVAL-NON-INSTITUTION^GN^0^1319^^P^45^2^1^1^1^1^2^30,40,55,80,85,50,60,65,70
;;39^NURSING HOME CARE-LTC^NL^0^1319^^P^46^2^1^1^1^1^2^30,40,55,80,85,50,60,65,70
Q
RUN N PRMSG,PRI,PRL,PRERR,PRCNT,PROK,PRIEN,PRNAME,PRNUM,PRFILE
S PRFILE=430.2
D MSG("\n PRCA*4.5*176 Post-Install .....")
D MSG("\n Making changes in ACCOUNTS RECEIVABLE CATEGORY file #"_PRFILE_" ...")
D MSG("\nIEN NAME CATEGORY NUMBER CHECK")
D MSG("--------------------------------------------------------")
S PRCNT=0 ; Records counter
S PRERR=0 ; Errors counter
F PRI=1:1 S PRL=$P($T(DATA+PRI),";;",2,255) Q:'PRL D
. S PRIEN=$P(PRL,U,1)
. S PRNAME=$P(PRL,U,2)
. S PRNUM=$P(PRL,U,8)
. ; Check name of the record to be change (and the presence of the record)
. S PROK=$$PRECHK(PRIEN,PRNAME) D:PROK
.. D UPDATE(PRIEN,PRNUM) S PRCNT=PRCNT+1
.. S PROK=$$POSTCHK(PRIEN,PRNUM) ; Check changes
. I 'PROK S PRERR=PRERR+1
. D OUTPUT ; Give a message
I 'PRERR S PRMSG=PRCNT_" records have been updated successfully"
E I PRERR=PRCNT S PRMSG="Warning! File #"_PRFILE_" was not updated due to errors"
E S PRMSG="Warning! "_PRERR_" records were not updated due to errors"
D MSG("\n"_PRMSG)
Q
OUTPUT N PRMSG,PRRES,PRNAM2
S PRRES=$S(PROK:"OK",1:"Error")
S PRNAM2=$$NAME(PRIEN,PRNAME)
S PRMSG=$J(PRIEN,2)_" "_PRNAM2_$J("",35-$L(PRNAM2))_" "_$J(PRNUM,2)_$J("",8)_PRRES
D MSG(PRMSG)
Q
; Change data
UPDATE(PRIEN,PRNUM) N PRRT,PRERR
S PRRT(PRFILE,PRIEN_",",6)=PRNUM
D FILE^DIE("K","PRRT","PRERR")
Q
; Pre-check - does the name conform?
PRECHK(PRIEN,PRNAME) ;
Q $P($G(^PRCA(PRFILE,PRIEN,0)),U,1)=PRNAME
; Post-check - have the change appeared?
POSTCHK(PRIEN,PRNUM) ;
Q $P($G(^PRCA(PRFILE,PRIEN,0)),U,7)=PRNUM
;
MSG(PRTXT) N PRMSG,PRI
F PRI=1:1:$L(PRTXT,"\n") S PRMSG(PRI)=$P(PRTXT,"\n",PRI)
D MES^XPDUTL(.PRMSG)
Q
;Get the current name, but if it's empty - use default
NAME(PRIEN,PRDFLT) N PRNM
S PRNM=$P($G(^PRCA(PRFILE,PRIEN,0)),U)
Q $S(PRNM="":$G(PRDFLT),1:PRNM)
; For testing only - remove values
CLEAR N PRI,PRL,PRFILE
S PRFILE=430.2
F PRI=1:1 S PRL=+$P($T(DATA+PRI),";;",2) Q:'PRL D UPDATE(PRL,0)
W !,"Records now have 0 settings!"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAI176 2957 printed Nov 22, 2024@16:50:18 Page 2
PRCAI176 ;WOIFO/AAT-POST-INSTALL ROUTINE PATCH PRCA*4.5*176 ;08-Feb-02
+1 ;;4.5;Accounts Receivable;**176**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;;
+4 QUIT
+5 ;
DATA ;;Only "CATEGORY NUMBER" (piece 8 here) are to be changed in the file!
+1 ;;33^ADULT DAY HEALTH CARE^AD^0^1319^^P^40^2^1^1^1^1^2^30,40,55,80,85,50,60,65,70
+2 ;;34^DOMICILIARY^DO^0^1319^^P^41^2^1^1^1^1^2^30,40,55,80,85,50,60,65,70
+3 ;;35^RESPITE CARE-INSTITUTIONAL^RC^0^1319^^P^42^2^1^1^1^1^2^30,40,55,80,85,50,60,65,70
+4 ;;36^RESPITE CARE-NON-INSTITUTIONAL^RN^0^1319^^P^43^2^1^1^1^1^2^30,40,55,80,85,50,60,65,70
+5 ;;37^GERIATRIC EVAL-INSTITUTIONAL^GE^0^1319^^P^44^2^1^1^1^1^2^30,40,55,80,85,50,60,65,70
+6 ;;38^GERIATRIC EVAL-NON-INSTITUTION^GN^0^1319^^P^45^2^1^1^1^1^2^30,40,55,80,85,50,60,65,70
+7 ;;39^NURSING HOME CARE-LTC^NL^0^1319^^P^46^2^1^1^1^1^2^30,40,55,80,85,50,60,65,70
+8 QUIT
RUN NEW PRMSG,PRI,PRL,PRERR,PRCNT,PROK,PRIEN,PRNAME,PRNUM,PRFILE
+1 SET PRFILE=430.2
+2 DO MSG("\n PRCA*4.5*176 Post-Install .....")
+3 DO MSG("\n Making changes in ACCOUNTS RECEIVABLE CATEGORY file #"_PRFILE_" ...")
+4 DO MSG("\nIEN NAME CATEGORY NUMBER CHECK")
+5 DO MSG("--------------------------------------------------------")
+6 ; Records counter
SET PRCNT=0
+7 ; Errors counter
SET PRERR=0
+8 FOR PRI=1:1
SET PRL=$PIECE($TEXT(DATA+PRI),";;",2,255)
if 'PRL
QUIT
Begin DoDot:1
+9 SET PRIEN=$PIECE(PRL,U,1)
+10 SET PRNAME=$PIECE(PRL,U,2)
+11 SET PRNUM=$PIECE(PRL,U,8)
+12 ; Check name of the record to be change (and the presence of the record)
+13 SET PROK=$$PRECHK(PRIEN,PRNAME)
if PROK
Begin DoDot:2
+14 DO UPDATE(PRIEN,PRNUM)
SET PRCNT=PRCNT+1
+15 ; Check changes
SET PROK=$$POSTCHK(PRIEN,PRNUM)
End DoDot:2
+16 IF 'PROK
SET PRERR=PRERR+1
+17 ; Give a message
DO OUTPUT
End DoDot:1
+18 IF 'PRERR
SET PRMSG=PRCNT_" records have been updated successfully"
+19 IF '$TEST
IF PRERR=PRCNT
SET PRMSG="Warning! File #"_PRFILE_" was not updated due to errors"
+20 IF '$TEST
SET PRMSG="Warning! "_PRERR_" records were not updated due to errors"
+21 DO MSG("\n"_PRMSG)
+22 QUIT
OUTPUT NEW PRMSG,PRRES,PRNAM2
+1 SET PRRES=$SELECT(PROK:"OK",1:"Error")
+2 SET PRNAM2=$$NAME(PRIEN,PRNAME)
+3 SET PRMSG=$JUSTIFY(PRIEN,2)_" "_PRNAM2_$JUSTIFY("",35-$LENGTH(PRNAM2))_" "_$JUSTIFY(PRNUM,2)_$JUSTIFY("",8)_PRRES
+4 DO MSG(PRMSG)
+5 QUIT
+6 ; Change data
UPDATE(PRIEN,PRNUM) NEW PRRT,PRERR
+1 SET PRRT(PRFILE,PRIEN_",",6)=PRNUM
+2 DO FILE^DIE("K","PRRT","PRERR")
+3 QUIT
+4 ; Pre-check - does the name conform?
PRECHK(PRIEN,PRNAME) ;
+1 QUIT $PIECE($GET(^PRCA(PRFILE,PRIEN,0)),U,1)=PRNAME
+2 ; Post-check - have the change appeared?
POSTCHK(PRIEN,PRNUM) ;
+1 QUIT $PIECE($GET(^PRCA(PRFILE,PRIEN,0)),U,7)=PRNUM
+2 ;
MSG(PRTXT) NEW PRMSG,PRI
+1 FOR PRI=1:1:$LENGTH(PRTXT,"\n")
SET PRMSG(PRI)=$PIECE(PRTXT,"\n",PRI)
+2 DO MES^XPDUTL(.PRMSG)
+3 QUIT
+4 ;Get the current name, but if it's empty - use default
NAME(PRIEN,PRDFLT) NEW PRNM
+1 SET PRNM=$PIECE($GET(^PRCA(PRFILE,PRIEN,0)),U)
+2 QUIT $SELECT(PRNM="":$GET(PRDFLT),1:PRNM)
+3 ; For testing only - remove values
CLEAR NEW PRI,PRL,PRFILE
+1 SET PRFILE=430.2
+2 FOR PRI=1:1
SET PRL=+$PIECE($TEXT(DATA+PRI),";;",2)
if 'PRL
QUIT
DO UPDATE(PRL,0)
+3 WRITE !,"Records now have 0 settings!"
+4 QUIT
