AZSLS03 ; LOAD S03 TABLE INTO PROVIDER/VENDOR [ 12/23/85 1:50 PM ]
K
S U="^",BEEP=$C(7)_$C(7),QFLG=0,INC=0
S DIC=9999999.09,DIC(0)="XLF",DLAYGO=9999999.09,DUZ(0)="@"
U 0 W !,"Opening input file. Please wait."
O 47:("AFU":81:81) U 47 G:$ZA\32768#2 OERR
U 47 W *5
F L=0:0 D PROC Q:QFLG
U 0 W !!,"Records read=",INC,!
I QFLG=1 U 0 W !!,"Error encountered. Job aborted!",!! G EOJ
U 0 W !!,"Load complete!",!!
EOJ ; CLOSE INPUT FILE AND QUIT
C 47
Q
PROC ; PROCESS INPUT RECORDS
D READ
Q:QFLG
S INC=INC+1
S CODE=$E(X,9,11),DISC=$E(X,51,52),NAME=$E(X,25,50) D RMB
I CODE'?3N!(DISC'?2N)!(NAME="") U 0 W !,"Bad data=",X,! S QFLG=1 Q
D SETAFFL
U 0 W !,AFFL," ",DISC," ",CODE," ",NAME
S DIC("DR")=".02///"_""""_AFFL_""""_".03///"_""""_DISC_""""_".04///"_""""_CODE_"""",X=NAME D ^DIC
I Y<0 S QFLG=1 U 0 W !!,X,"/",DR("DR") Q
Q
READ ; READ INPUT FILE
U 47 R X S:$ZA\16384#2 QFLG=2
Q
RMB ; REMOVE LEADING AND TRAILING BLANKS AND BLANK AFTER COMMA
F I=$L(NAME):-1:1 I $E(NAME,I)'=" " S NAME=$E(NAME,1,I) Q
F L=0:0 Q:$E(NAME)'=" " S NAME=$E(NAME,2,99)
S POS=$F(NAME,", ") Q:POS=0
S NAME=$E(NAME,1,POS-2)_$E(NAME,POS,99)
Q
SETAFFL ; SET AFFILIATION
S AFFL=1
I DISC="00" I CODE="090"!(CODE]"095"&(CODE']"099")) S AFFL=9 Q
Q:DISC']"09"
I DISC="10",CODE="754" S AFFL=2 Q
Q:DISC']"12"
I DISC="13" I CODE]"379"&(CODE']"381") S AFFL=9 Q
I DISC="13",CODE="390" S AFFL=2 Q
I DISC="14" S AFFL=4 Q
I DISC="15" S AFFL=9 Q
Q:DISC']"18"
I DISC="19" S AFFL=3 Q
I DISC="20" S AFFL=9 Q
Q:DISC']"50"
I DISC="51" S AFFL=3 Q
I DISC="52",CODE="210" S AFFL=2 Q
I DISC="52",CODE="211" S AFFL=9 Q
I DISC="53" S AFFL=3 Q
I DISC="55" S AFFL=3 Q
I DISC="57",CODE="178" S AFFL=9 Q
Q
OERR ; OPEN ERROR
U 0 W BEEP
W !!,"Open error on input file!",!!
Q
AZSLS03 ; LOAD S03 TABLE INTO PROVIDER/VENDOR [ 12/23/85 1:50 PM ]
+1 KILL
+2 SET U="^"
SET BEEP=$CHAR(7)_$CHAR(7)
SET QFLG=0
SET INC=0
+3 SET DIC=9999999.09
SET DIC(0)="XLF"
SET DLAYGO=9999999.09
SET DUZ(0)="@"
+4 USE 0
WRITE !,"Opening input file. Please wait."
+5 OPEN 47:("AFU":81:81)
USE 47
IF $ZA\32768#2
GOTO OERR
+6 USE 47
WRITE *5
+7 FOR L=0:0
DO PROC
IF QFLG
QUIT
+8 USE 0
WRITE !!,"Records read=",INC,!
+9 IF QFLG=1
USE 0
WRITE !!,"Error encountered. Job aborted!",!!
GOTO EOJ
+10 USE 0
WRITE !!,"Load complete!",!!
EOJ ; CLOSE INPUT FILE AND QUIT
+1 CLOSE 47
+2 QUIT
PROC ; PROCESS INPUT RECORDS
+1 DO READ
+2 IF QFLG
QUIT
+3 SET INC=INC+1
+4 SET CODE=$EXTRACT(X,9,11)
SET DISC=$EXTRACT(X,51,52)
SET NAME=$EXTRACT(X,25,50)
DO RMB
+5 IF CODE'?3N!(DISC'?2N)!(NAME="")
USE 0
WRITE !,"Bad data=",X,!
SET QFLG=1
QUIT
+6 DO SETAFFL
+7 USE 0
WRITE !,AFFL," ",DISC," ",CODE," ",NAME
+8 SET DIC("DR")=".02///"_""""_AFFL_""""_".03///"_""""_DISC_""""_".04///"_""""_CODE_""""
SET X=NAME
DO ^DIC
+9 IF Y<0
SET QFLG=1
USE 0
WRITE !!,X,"/",DR("DR")
QUIT
+10 QUIT
READ ; READ INPUT FILE
+1 USE 47
READ X
IF $ZA\16384#2
SET QFLG=2
+2 QUIT
RMB ; REMOVE LEADING AND TRAILING BLANKS AND BLANK AFTER COMMA
+1 FOR I=$LENGTH(NAME):-1:1
IF $EXTRACT(NAME,I)'=" "
SET NAME=$EXTRACT(NAME,1,I)
QUIT
+2 FOR L=0:0
IF $EXTRACT(NAME)'=" "
QUIT
SET NAME=$EXTRACT(NAME,2,99)
+3 SET POS=$FIND(NAME,", ")
IF POS=0
QUIT
+4 SET NAME=$EXTRACT(NAME,1,POS-2)_$EXTRACT(NAME,POS,99)
+5 QUIT
SETAFFL ; SET AFFILIATION
+1 SET AFFL=1
+2 IF DISC="00"
IF CODE="090"!(CODE]"095"&(CODE']"099"))
SET AFFL=9
QUIT
+3 IF DISC']"09"
QUIT
+4 IF DISC="10"
IF CODE="754"
SET AFFL=2
QUIT
+5 IF DISC']"12"
QUIT
+6 IF DISC="13"
IF CODE]"379"&(CODE']"381")
SET AFFL=9
QUIT
+7 IF DISC="13"
IF CODE="390"
SET AFFL=2
QUIT
+8 IF DISC="14"
SET AFFL=4
QUIT
+9 IF DISC="15"
SET AFFL=9
QUIT
+10 IF DISC']"18"
QUIT
+11 IF DISC="19"
SET AFFL=3
QUIT
+12 IF DISC="20"
SET AFFL=9
QUIT
+13 IF DISC']"50"
QUIT
+14 IF DISC="51"
SET AFFL=3
QUIT
+15 IF DISC="52"
IF CODE="210"
SET AFFL=2
QUIT
+16 IF DISC="52"
IF CODE="211"
SET AFFL=9
QUIT
+17 IF DISC="53"
SET AFFL=3
QUIT
+18 IF DISC="55"
SET AFFL=3
QUIT
+19 IF DISC="57"
IF CODE="178"
SET AFFL=9
QUIT
+20 QUIT
OERR ; OPEN ERROR
+1 USE 0
WRITE BEEP
+2 WRITE !!,"Open error on input file!",!!
+3 QUIT
