AZSLS03.m

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