IB499PO ;BL/BL - PRE-INSTALL ROUTINE FOR IB*2.0*499 ;01-APR-13
;;2.0;INTEGRATED BILLING;**499**;01-APR-13;Build 44
;
;Purpose of this routine is to modify the help text of the .03 field of the 355.81 file
;DBIA 2037 data in this file is used by Registration is registering patients
;
;File data sits in ^DD(355.81,.03,21) Help text. Must find the last line and add new text
Q
NB N INC,LINC
S INC="",LINC=""
F S INC=$O(^DD(355.81,.03,21,INC)) Q:INC="" S LINC=INC
;Now we have the last line check to see if it contains the newborn code NB
Q:^DD(355.81,.03,21,LINC,0)["Newborn"
;Set the code
S ^DD(355.81,.03,21,(LINC+1),0)=" NB Newborn of Vet"
S $P(^DD(355.81,.03,21,0),"^",3)=($P(^DD(355.81,.03,21,0),"^",3)+1)
S $P(^DD(355.81,.03,21,0),"^",4)=($P(^DD(355.81,.03,21,0),"^",4)+1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB499PO 826 printed Nov 22, 2024@17:15:53 Page 2
IB499PO ;BL/BL - PRE-INSTALL ROUTINE FOR IB*2.0*499 ;01-APR-13
+1 ;;2.0;INTEGRATED BILLING;**499**;01-APR-13;Build 44
+2 ;
+3 ;Purpose of this routine is to modify the help text of the .03 field of the 355.81 file
+4 ;DBIA 2037 data in this file is used by Registration is registering patients
+5 ;
+6 ;File data sits in ^DD(355.81,.03,21) Help text. Must find the last line and add new text
+7 QUIT
NB NEW INC,LINC
+1 SET INC=""
SET LINC=""
+2 FOR
SET INC=$ORDER(^DD(355.81,.03,21,INC))
if INC=""
QUIT
SET LINC=INC
+3 ;Now we have the last line check to see if it contains the newborn code NB
+4 if ^DD(355.81,.03,21,LINC,0)["Newborn"
QUIT
+5 ;Set the code
+6 SET ^DD(355.81,.03,21,(LINC+1),0)=" NB Newborn of Vet"
+7 SET $PIECE(^DD(355.81,.03,21,0),"^",3)=($PIECE(^DD(355.81,.03,21,0),"^",3)+1)
+8 SET $PIECE(^DD(355.81,.03,21,0),"^",4)=($PIECE(^DD(355.81,.03,21,0),"^",4)+1)
+9 QUIT
