Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AIBCVT5

AIBCVT5.m

Go to the documentation of this file.
  1. AIBCVT5 ;IHS/DDPS/DFM-IBM STAT RECORDS FIELD PROCESS [ 12/01/88 3:46 PM ]
  1. ;1.3; 9/23/88 RESTRUCTURE, ALLOW FOR REGISTRATION ELIGIBILITY FILE
  1. ;1.0; 3/28/88
  1. FIELDS ;BUILD RECORD FIELDS
  1. S AIBN=$P(AIBC(AIBCN1,AIBI),U,1)
  1. S AIBB=$P(AIBC(AIBCN1,AIBI),U,2)
  1. S AIBL=$P(AIBC(AIBCN1,AIBI),U,3)
  1. S AIBE=AIBB-1,AIBOL(0)=$L(AIBOT)
  1. S AIBOL(1)=$L(AIBOT(1))
  1. S AIBOL=AIBOL(0)+AIBOL(1)
  1. S AIBFC=$P(AIBC(AIBCN1,AIBI),U,4)
  1. S AIBED=$P(AIBC(AIBCN1,AIBI),U,5)
  1. S AIBLE=$P(AIBC(AIBCN1,AIBI),U,6)
  1. S AIBI2=AIBI+1,X=$P(AIBIN,U,AIBI2) I $E(X,$L(X))=$C(13) S X=$E(X,1,$L(X)-1)
  1. G:$L(AIBED)=0 EDITOK X AIBED G:AIBG="R" RETURN G:AIBG="W" WRITE
  1. I AIBER="" G EDITOK
  1. I AIBER='WARN G CKMSG
  1. S AIBER=""
  1. S:$D(AIBPID) AIBMSG=AIBMSG_" for patient "_AIBZ_AIBPID
  1. D ERRMSP^AIBCVT6 G EDITOK
  1. CKMSG ;CHECK FOR OTHER ERROR MESSAGE
  1. D:$L(AIBMSG)>0 ERRMSP^AIBCVT6
  1. S AIBMSG="Edit error on field "_AIBN_" value was "_X
  1. I $D(AIBPID) S AIBMSG=AIBMSG_" for patient "_AIBZ_AIBPID
  1. D ERRMSP^AIBCVT6
  1. G RETURN
  1. EDITOK ;CHECK FIELD LENGTH
  1. S AIBER="" G:$L(X)=AIBL MOVE G:$L(X)<AIBL FILLOGIC
  1. S AIBMSG="Field "_AIBN_" too long should be "_AIBL
  1. S AIBMSG=AIBMSG_" but is "_$L(X)_" value is "_X
  1. I $D(AIBPID) S AIBMSG=AIBMSG_" for patient "_AIBZ_AIBPID
  1. D ERRMSP^AIBCVT6
  1. I AIBLE="A" S AIBMSG="Program Aborted",AIBER="A" G RETURN
  1. I AIBLE="R" S AIBER="Y",AIBI=AIBC G RETURN
  1. I AIBLE="" G TRUNCATE
  1. S X="",AIBMSG=" field set to spaces" D ERRMSP^AIBCVT6 G BLANK
  1. TRUNCATE ;TRUNCATE FIELD TO FIT
  1. S X=$E(X,1,AIBL),AIBMSG=" Truncated to "_X D ERRMSP^AIBCVT6 G MOVE
  1. FILLOGIC ;LOGIC FOR FILLING SHORT FIELDS
  1. G:AIBFC="B" BLANK G:X="" BLANK G:AIBFC="S" STRIPDP G ZEROES
  1. STRIPDP ;STRIP DECIMAL POINT FROM ICD9 CODES
  1. S Y=$F(X,"."),X=$E(X,1,Y-2)_$E(X,Y,$L(AIBL))
  1. S:X?1"E"4N X=$E(X,2,5) S:X?1"E"3N1" " X=$E(X,2,4) G MOVE
  1. BLANK ;FIELD SHOULD BE LEFT JUSTIFIED FILL WITH BLANK TO RIGHT
  1. S X=X_$J("",AIBL-$L(X)) G MOVE
  1. ZEROES ;FIELD SHOULD BE RIGHT JUSTIFIED FILL WITH ZEROES TO LEFT
  1. S AIBZR=$E(AIBZRS,1,AIBL-$L(X)),X=AIBZR_X
  1. MOVE ;ADD FIELD TO OUTPUT RECORD
  1. I 250>AIBE+AIBL G MOVE2
  1. S:AIBOL(0)<250 AIBOT=AIBOT_$E(X,1,250-AIBOL(0)),X=$E(X,250-AIBOL(0),256)
  1. G MOVOVFL
  1. MOVE2 ;
  1. I AIBE>AIBOL(0) G MOVE3
  1. S AIBOT=$E(AIBOT,1,AIBE)_X_$E(AIBOT,AIBB+AIBL-1,250-AIBL) G CKINS
  1. MOVE3 ;
  1. I AIBOL(0)<AIBE S AIBOT=AIBOT_$J("",AIBB-$L(AIBOT)-1)_X G CKINS
  1. I AIBOL(0)=AIBE S AIBOT=AIBOT_X G CKINS
  1. MOVOVFL ;ADD FIELD TO OVERFLOW RECORD
  1. I AIBE-AIBOL(0)>AIBOL(1) G MOVOVF2
  1. S AIBOT(1)=$E(AIBOT(1),1,AIBE-AIBOL(0))_X_$E(AIBOT(1),AIBB-AIBOL(0)+AIBL-1,255) G CKINS
  1. MOVOVF2 ;
  1. I AIBE-AIBOL(0)<AIBOL G MOVOVF3
  1. S AIBOT(1)=AIBOT(1)_$J("",AIBB-AIBOL(0)-$L(AIBOT(1))-1)_X G CKINS
  1. MOVOVF3 ;
  1. I AIBOL=AIBE S AIBOT(1)=AIBOT(1)_X G CKINS
  1. CKINS ;CHECK IF PIECE IS TO TO INSERTED INTO NODE
  1. G:AIBG="I" INSPIECE G RETURN
  1. INSPIECE ;INSERT MISSING PIECE IN INPUT NODE
  1. S AIBI(0)=0 F AIBI3=1:1:AIBI S AIBI(0)=AIBI(0)+$L($P(AIBIN,U,AIBI3))
  1. S AIBIN=$E(AIBIN,1,AIBI(0))_U_$E(AIBIN,AIBI(0)+1,999) G RETURN
  1. WRITE ;WRITE ABILITY FOR REGISTRATION HEADER RECORD
  1. S AIBH2=X_$J("",14-$L(X)),AIBOT=AIBH1_AIBH2_AIBH3
  1. I AIBGBLP="AGHA" S AIBOT=AIBOT_AIBH4
  1. E S AIBOT=AIBOT_AIBH5
  1. S AIBOT=AIBOT_$J("",250-$L(AIBOT)),AIBOT(1)=$J("",60)
  1. S AIBCTB=AIBCTB+1 D ^AIBCVT3
  1. RETURN ;RETURN TO CALLING ROUTINE
  1. S AIBG="" Q