ACHSHV01.m

ACHSHV01 ; IHS/ITSC/PMF - READ HI VOL NOTIFICATION REPORT ;  [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 ;

 ; For description of the input records, see ACHSTM17.

 ;

 W @IOF,$$REPEAT^XLFSTR("*",52),!,"*         READ CHS HV NOTIFICATION REPORT          *",!,$$REPEAT^XLFSTR("*",52)

 I '$L($$AOP^ACHS(2,1)) D NODIR^ACHSMD0 G ABEND

 S (ACHSPTCT,ACHSFLG,ACHSPGNO,ACHSBLCT,ACHSLCT)=0

A0 ; Select printer for report.

 S %ZIS="P",%ZIS("A")="Enter Device for Error Report: "

 D ^%ZIS

 I POP U IO(0) W !,*7,"Device Not Available -- Job Aborted" G ABEND

A1 ; Open file selected in ACHSHV04.

 S ACHSZDEV=IO

 I $$OPEN^%ZISH($$AOP^ACHS(2,1),$P(^ACHSHVLG(ACHSV,1,ACHSNO,0),U,4),"R") U IO(0) W !!,"OPEN FAILURE ON DEVICE FOR FILE ",$P(^ACHSHVLG(ACHSV,1,ACHSNO,0),U,4) G ABEND

 S ACHSX=$P(ACHSUFLS(ACHSNO),U,5),ACHSFN=$E($P(^AUTTVNDR(ACHSX,0),U,1),1,30)

 S ACHSZDEV(1)=IO,IO=ACHSZDEV,ACHSZDEV=ACHSZDEV(1)

 K ACHSZDEV(1)

 D HDR1

A3 ; Read from file, loop.

 U ACHSZDEV

 R ACHSDATA:1

 G ABEND:'$T

 G END:$$STATUS^%ZISH

 S ACHSBLFG=0

 D SEARCH

 I ACHSSKIP G A3

INDRD ;

 I $L(ACHSDATA) G L1

 I ACHSBLFG=1 S ACHSBLCT=ACHSBLCT+1

 G A3

 ;

L1 ; Set data into ^ACHSHVOP(.

 G L2:ACHSFLG=1,L3:ACHSFLG=2

 S ACHSPTCT=ACHSPTCT+1

 S X=$E(ACHSDATA,1,30)

 D SPREMOV

 S Y=$P(X,",",2)

 I $E(Y,1,1)=" " S Y=$E(Y,2,$L(Y)),X=$P(X,",",1)_","_Y

 S $P(^ACHSHVOP(ACHSPTCT),U,1)=X,X=$E(ACHSDATA,31,36)

 I +X=0 S X=""

 S $P(^ACHSHVOP(ACHSPTCT),U,4)=X,$P(^ACHSHVOP(ACHSPTCT),U,5)=+$E(ACHSDATA,43,44),X=$E(ACHSDATA,49,59)

 I +X=0 S X=""

 S $P(^ACHSHVOP(ACHSPTCT),U,6)=X

 K %DT

 S X=$E(ACHSDATA,63,72)

 D ^%DT

 I Y=-1 S Y=""

 S $P(^ACHSHVOP(ACHSPTCT),U,7)=Y,$P(^ACHSHVOP(ACHSPTCT),U,8)=$E(ACHSDATA,126,132),ACHSFLG=1

 G A3

 ;

L2 ;

 S X=$E(ACHSDATA,1,25)

 D SPREMOV

 S $P(^ACHSHVOP(ACHSPTCT),U,2)=X,ACHSFLG=2

 G A3

 ;

L3 ;

 S Y=$E(ACHSDATA,22,26),X=$E(ACHSDATA,1,20)

 D SPREMOV

 S W=$P(X,",",1),Z=$P(X,",",2)

 S:$E(Z,1,1)=" " Z=$E(Z,2,$L(Z))

 S X=W_","_Z_" "_Y,$P(^ACHSHVOP(ACHSPTCT),U,3)=X

 I $P(^ACHSHVOP(ACHSPTCT),U,4)="" U IO W ?10,"MISSING CHART NUMB",?35,$P(^ACHSHVOP(ACHSPTCT),U,1),?65,$P(^ACHSHVOP(ACHSPTCT),U,8),!

 I $P(^ACHSHVOP(ACHSPTCT),U,5)=0 U IO W ?10,"MISSING FIN CLASS",?35,$P(^ACHSHVOP(ACHSPTCT),U,1),?65,$P(^ACHSHVOP(ACHSPTCT),U,8),!

 I $P(^ACHSHVOP(ACHSPTCT),U,6)="" U IO W ?10,"MISSING SOC. SEC. #",?35,$P(^ACHSHVOP(ACHSPTCT),U,1),?65,$P(^ACHSHVOP(ACHSPTCT),U,8),!

 S ACHSLCT=ACHSLCT+1

 I ACHSLCT>55 D HDR1

 S ACHSFLG=0

 G A3

 ;

END ; Write totals, close device(s), kill vars, quit.

 U IO(0)

 W !?10,"TOTAL RECORDS CONVERTED = ",ACHSPTCT

 D ^%ZISC

 S IO=ACHSZDEV,IONOFF=""

 D ^%ZISC

 K X,Y,Z,I,ACHSBLFG,ACHSPTCT,ACHSFLG,ACHSDATA,ACHSSKIP

 Q

 ;

SEARCH ; Skip records of 0 length, or begin with below literals.

 S ACHSSKIP=0

 I $L(ACHSDATA)=0 S ACHSBLFG=1 Q

 I $E(ACHSDATA,1,9)="PCC292-R2" S ACHSBLCT=0 G SRCHSKP

 I $E(ACHSDATA,1,15)="TOTAL PATIENTS:" G SRCHSKP

 I $E(ACHSDATA,1,9)="LHHS PICS" G SRCHSKP

 I $E(ACHSDATA,1,6)="NAME /" G SRCHSKP

 I $E(ACHSDATA,1,15)="MAILING ADDRESS" S ACHSSKIP=2

 Q

 ;

SRCHSKP ;

 S ACHSSKIP=1

 Q

 ;

SPREMOV ; Remove trailing spaces from X.

 F ACHSI=$L(X):-1:1 Q:$E(X,ACHSI,ACHSI)'=" "  I $E(X,ACHSI,ACHSI)=" " S X=$E(X,1,ACHSI-1)

 Q

 ;

HDR1 ; Print header.

 U IO

 S ACHSPGNO=ACHSPGNO+1,ACHSLCT=0

 W @IOF,?10,"OUTPATIENT NOTIFICATION REPORT -- CONVERSION ERRORS",?73,"PAGE ",ACHSPGNO,!?25,"FOR ",ACHSFN,!?10,$$REPEAT^XLFSTR("-",62),!?10,"TYPE OF ERROR",?35,"PATIENT NAME",?65,"ACCT # ",!?10,$$REPEAT^XLFSTR("-",62),!!

 Q

 ;

ABEND ; Display error if device noopen or read fail.

 U IO(0)

 W !!,"ABNORNAL END OF JOB"

 I $$DIR^XBDIR("E","Enter <RETURN> to Continue")

 Q

 ;

ACHSHV01  ; IHS/ITSC/PMF - READ HI VOL NOTIFICATION REPORT ;  [ 10/16/2001   8:16 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 +2       ;

 +3       ; For description of the input records, see ACHSTM17.

 +4       ;

 +5        WRITE @IOF,$$REPEAT^XLFSTR("*",52),!,"*         READ CHS HV NOTIFICATION REPORT          *",!,$$REPEAT^XLFSTR("*",52)

 +6        IF '$LENGTH($$AOP^ACHS(2,1))

               DO NODIR^ACHSMD0

               GOTO ABEND

 +7        SET (ACHSPTCT,ACHSFLG,ACHSPGNO,ACHSBLCT,ACHSLCT)=0

A0        ; Select printer for report.

 +1        SET %ZIS="P"

           SET %ZIS("A")="Enter Device for Error Report: "

 +2        DO ^%ZIS

 +3        IF POP

               USE IO(0)

               WRITE !,*7,"Device Not Available -- Job Aborted"

               GOTO ABEND

A1        ; Open file selected in ACHSHV04.

 +1        SET ACHSZDEV=IO

 +2        IF $$OPEN^%ZISH($$AOP^ACHS(2,1),$PIECE(^ACHSHVLG(ACHSV,1,ACHSNO,0),U,4),"R")

               USE IO(0)

               WRITE !!,"OPEN FAILURE ON DEVICE FOR FILE ",$PIECE(^ACHSHVLG(ACHSV,1,ACHSNO,0),U,4)

               GOTO ABEND

 +3        SET ACHSX=$PIECE(ACHSUFLS(ACHSNO),U,5)

           SET ACHSFN=$EXTRACT($PIECE(^AUTTVNDR(ACHSX,0),U,1),1,30)

 +4        SET ACHSZDEV(1)=IO

           SET IO=ACHSZDEV

           SET ACHSZDEV=ACHSZDEV(1)

 +5        KILL ACHSZDEV(1)

 +6        DO HDR1

A3        ; Read from file, loop.

 +1        USE ACHSZDEV

 +2        READ ACHSDATA:1

 +3        IF '$TEST

               GOTO ABEND

 +4        IF $$STATUS^%ZISH

               GOTO END

 +5        SET ACHSBLFG=0

 +6        DO SEARCH

 +7        IF ACHSSKIP

               GOTO A3

INDRD     ;

 +1        IF $LENGTH(ACHSDATA)

               GOTO L1

 +2        IF ACHSBLFG=1

               SET ACHSBLCT=ACHSBLCT+1

 +3        GOTO A3

 +4       ;

L1        ; Set data into ^ACHSHVOP(.

 +1        IF ACHSFLG=1

               GOTO L2

           IF ACHSFLG=2

               GOTO L3

 +2        SET ACHSPTCT=ACHSPTCT+1

 +3        SET X=$EXTRACT(ACHSDATA,1,30)

 +4        DO SPREMOV

 +5        SET Y=$PIECE(X,",",2)

 +6        IF $EXTRACT(Y,1,1)=" "

               SET Y=$EXTRACT(Y,2,$LENGTH(Y))

               SET X=$PIECE(X,",",1)_","_Y

 +7        SET $PIECE(^ACHSHVOP(ACHSPTCT),U,1)=X

           SET X=$EXTRACT(ACHSDATA,31,36)

 +8        IF +X=0

               SET X=""

 +9        SET $PIECE(^ACHSHVOP(ACHSPTCT),U,4)=X

           SET $PIECE(^ACHSHVOP(ACHSPTCT),U,5)=+$EXTRACT(ACHSDATA,43,44)

           SET X=$EXTRACT(ACHSDATA,49,59)

 +10       IF +X=0

               SET X=""

 +11       SET $PIECE(^ACHSHVOP(ACHSPTCT),U,6)=X

 +12       KILL %DT

 +13       SET X=$EXTRACT(ACHSDATA,63,72)

 +14       DO ^%DT

 +15       IF Y=-1

               SET Y=""

 +16       SET $PIECE(^ACHSHVOP(ACHSPTCT),U,7)=Y

           SET $PIECE(^ACHSHVOP(ACHSPTCT),U,8)=$EXTRACT(ACHSDATA,126,132)

           SET ACHSFLG=1

 +17       GOTO A3

 +18      ;

L2        ;

 +1        SET X=$EXTRACT(ACHSDATA,1,25)

 +2        DO SPREMOV

 +3        SET $PIECE(^ACHSHVOP(ACHSPTCT),U,2)=X

           SET ACHSFLG=2

 +4        GOTO A3

 +5       ;

L3        ;

 +1        SET Y=$EXTRACT(ACHSDATA,22,26)

           SET X=$EXTRACT(ACHSDATA,1,20)

 +2        DO SPREMOV

 +3        SET W=$PIECE(X,",",1)

           SET Z=$PIECE(X,",",2)

 +4        IF $EXTRACT(Z,1,1)=" "

               SET Z=$EXTRACT(Z,2,$LENGTH(Z))

 +5        SET X=W_","_Z_" "_Y

           SET $PIECE(^ACHSHVOP(ACHSPTCT),U,3)=X

 +6        IF $PIECE(^ACHSHVOP(ACHSPTCT),U,4)=""

               USE IO

               WRITE ?10,"MISSING CHART NUMB",?35,$PIECE(^ACHSHVOP(ACHSPTCT),U,1),?65,$PIECE(^ACHSHVOP(ACHSPTCT),U,8),!

 +7        IF $PIECE(^ACHSHVOP(ACHSPTCT),U,5)=0

               USE IO

               WRITE ?10,"MISSING FIN CLASS",?35,$PIECE(^ACHSHVOP(ACHSPTCT),U,1),?65,$PIECE(^ACHSHVOP(ACHSPTCT),U,8),!

 +8        IF $PIECE(^ACHSHVOP(ACHSPTCT),U,6)=""

               USE IO

               WRITE ?10,"MISSING SOC. SEC. #",?35,$PIECE(^ACHSHVOP(ACHSPTCT),U,1),?65,$PIECE(^ACHSHVOP(ACHSPTCT),U,8),!

 +9        SET ACHSLCT=ACHSLCT+1

 +10       IF ACHSLCT>55

               DO HDR1

 +11       SET ACHSFLG=0

 +12       GOTO A3

 +13      ;

END       ; Write totals, close device(s), kill vars, quit.

 +1        USE IO(0)

 +2        WRITE !?10,"TOTAL RECORDS CONVERTED = ",ACHSPTCT

 +3        DO ^%ZISC

 +4        SET IO=ACHSZDEV

           SET IONOFF=""

 +5        DO ^%ZISC

 +6        KILL X,Y,Z,I,ACHSBLFG,ACHSPTCT,ACHSFLG,ACHSDATA,ACHSSKIP

 +7        QUIT 

 +8       ;

SEARCH    ; Skip records of 0 length, or begin with below literals.

 +1        SET ACHSSKIP=0

 +2        IF $LENGTH(ACHSDATA)=0

               SET ACHSBLFG=1

               QUIT 

 +3        IF $EXTRACT(ACHSDATA,1,9)="PCC292-R2"

               SET ACHSBLCT=0

               GOTO SRCHSKP

 +4        IF $EXTRACT(ACHSDATA,1,15)="TOTAL PATIENTS:"

               GOTO SRCHSKP

 +5        IF $EXTRACT(ACHSDATA,1,9)="LHHS PICS"

               GOTO SRCHSKP

 +6        IF $EXTRACT(ACHSDATA,1,6)="NAME /"

               GOTO SRCHSKP

 +7        IF $EXTRACT(ACHSDATA,1,15)="MAILING ADDRESS"

               SET ACHSSKIP=2

 +8        QUIT 

 +9       ;

SRCHSKP   ;

 +1        SET ACHSSKIP=1

 +2        QUIT 

 +3       ;

SPREMOV   ; Remove trailing spaces from X.

 +1        FOR ACHSI=$LENGTH(X):-1:1

               IF $EXTRACT(X,ACHSI,ACHSI)'=" "

                   QUIT 

               IF $EXTRACT(X,ACHSI,ACHSI)=" "

                   SET X=$EXTRACT(X,1,ACHSI-1)

 +2        QUIT 

 +3       ;

HDR1      ; Print header.

 +1        USE IO

 +2        SET ACHSPGNO=ACHSPGNO+1

           SET ACHSLCT=0

 +3        WRITE @IOF,?10,"OUTPATIENT NOTIFICATION REPORT -- CONVERSION ERRORS",?73,"PAGE ",ACHSPGNO,!?25,"FOR ",ACHSFN,!?10,$$REPEAT^XLFSTR("-",62),!?10,"TYPE OF ERROR",?35,"PATIENT NAME",?65,"ACCT # ",!?10,$$REPEAT^XLFSTR("-",62),!!

 +4        QUIT 

 +5       ;

ABEND     ; Display error if device noopen or read fail.

 +1        USE IO(0)

 +2        WRITE !!,"ABNORNAL END OF JOB"

 +3        IF $$DIR^XBDIR("E","Enter <RETURN> to Continue")

 +4        QUIT 

 +5       ;