ABPAMLBL ;PRINT INSURER MAILING LABELS (BATCH); [ 07/03/91 7:50 PM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
A0 G ABORT
;
A1 D DT^DICRW K ABPA("HD") S ABPA("HD",1)=ABPATLE
S ABPA("HD",2)="PRINT Claim Mailing LABELS (batch)" D ^ABPAHD
;
A2 K DIC,DIE,DA,DR S DIC="^ABPAMLBL(",DIC(0)="AEQZ"
S DIC("A")="Select MAILING LABEL POSTING PERIOD // " W !!! D ^DIC
G:+Y<0 END S ABPADFN=+Y,ABPAMLDT=Y(0,0)
;
A3 K DIC,DIE,DA,DR S DIC="^DIC(4,",DIC(0)="AEQZ"
S DIC("A")="Select MAILING LABEL FACILITY // " W ! D ^DIC
G:+Y<0 A2 S LOCCD=+Y
I $D(^ABPAMLBL(ABPADFN,"L",LOCCD,0))'=1 D G A3
.W !,*7,!?3,"<<< NO LABELS FOUND FOR '",Y(0,0)
.W "' DURING ",ABPAMLDT," >>>"
;
A4 S %ZIS("A")="Select LABEL PRINTER DEVICE: ",%IS="P" W ! D ^%ZIS
I $D(IO("S"))=1 X ^%ZIS(2,IO("S"),11)
K %ZIS("A"),%IS G:+IO=0 A3
U IO(0) W !!,"Please make sure labels have been put into the printer."
U IO(0) W !,"Press [RETURN] when you are ready... " R X:DTIME
G:'$T A6 U IO(0) W !!
;
A5 S FLBL="" S RR=0 F I=1:1 D Q:RR=""
.K NAME,ADDR,CITY,STATE,ZIP,DATA
.S RR=$O(^ABPAMLBL(ABPADFN,"L",LOCCD,"I","AC",RR)) Q:RR="" S R=0
.S R=$O(^ABPAMLBL(ABPADFN,"L",LOCCD,"I","AC",RR,R)) Q:+R=0
.Q:$D(^ABPAMLBL(ABPADFN,"L",LOCCD,"I",R,0))'=1
.Q:$D(^AUTNINS(R,0))'=1
.S NAME=$P(^AUTNINS(R,0),"^")
.I $D(^AUTNINS(R,1))=1 I $L($P(^AUTNINS(R,1),"^"))>3 D
..S DATA=^AUTNINS(R,1)
.I $D(^AUTNINS(R,1))=1 I $L($P(^AUTNINS(R,1),"^"))'>3 D
..S DATA=^AUTNINS(R,0)
.I $D(^AUTNINS(R,1))'=1 S DATA=^AUTNINS(R,0)
.S NAME(1)=$P(DATA,"^"),ADDR=$P(DATA,"^",2),CITY=$P(DATA,"^",3)
.S STATE="",PTR=$P(DATA,"^",4)
.I +PTR>0 I $D(^DIC(5,PTR,0))=1 D
..S STATE=$P(^DIC(5,PTR,0),"^",2)
.S ZIP=$P(DATA,"^",5)
.S:NAME(1)'=NAME NAME=NAME(1) K NAME(1)
.I $D(FLBL)=1 D
..F J=0:0 D Q:$D(FLBL)'=1
...I $D(IO("S"))=1 X ^%ZIS(2,IO("S"),10) H 2
...F K=1:1:2 D
....U IO W NAME
....U IO W !,ADDR,!,CITY,", ",STATE," ",ZIP
....U IO W !!!!
...H 2 I $D(IO("S"))=1 X ^%ZIS(2,IO("S"),11) H 2
...U IO(0) W !!,"ARE YOUR LABELS LINED UP" S %=2 D YN^DICN
...U IO(0) W !!
...I +%'=1 D
....U IO(0) W "Please adjust...press [RETURN] when ready"
....U IO(0) R X:DTIME U IO(0) W !!
...I +%=1 D
....K FLBL I $D(IO("S"))=1 X ^%ZIS(2,IO("S"),10) H 2
.F J=1:1:2 D
..U IO W NAME,!,ADDR,!,CITY,", ",STATE," ",ZIP,!!!!
.H 1
;
A6 H 2 I $D(IO("S"))=1 X ^%ZIS(2,IO("S"),11)
X ^%ZIS("C") K IOP,IO("S") U IO(0) W !!
;
END K X,Y,DIC,DIE,DA,DR,NAME,ADDR,CITY,STATE,ZIP,FLBL,ABPADFN,LOCCD,DATA
K ABPAMLDT,I,J,K
Q
;
ABORT W !!,"ACCESS DENIED!!!" Q
ABPAMLBL ;PRINT INSURER MAILING LABELS (BATCH); [ 07/03/91 7:50 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
A0 GOTO ABORT
+1 ;
A1 DO DT^DICRW
KILL ABPA("HD")
SET ABPA("HD",1)=ABPATLE
+1 SET ABPA("HD",2)="PRINT Claim Mailing LABELS (batch)"
DO ^ABPAHD
+2 ;
A2 KILL DIC,DIE,DA,DR
SET DIC="^ABPAMLBL("
SET DIC(0)="AEQZ"
+1 SET DIC("A")="Select MAILING LABEL POSTING PERIOD // "
WRITE !!!
DO ^DIC
+2 IF +Y<0
GOTO END
SET ABPADFN=+Y
SET ABPAMLDT=Y(0,0)
+3 ;
A3 KILL DIC,DIE,DA,DR
SET DIC="^DIC(4,"
SET DIC(0)="AEQZ"
+1 SET DIC("A")="Select MAILING LABEL FACILITY // "
WRITE !
DO ^DIC
+2 IF +Y<0
GOTO A2
SET LOCCD=+Y
+3 IF $DATA(^ABPAMLBL(ABPADFN,"L",LOCCD,0))'=1
Begin DoDot:1
+4 WRITE !,*7,!?3,"<<< NO LABELS FOUND FOR '",Y(0,0)
+5 WRITE "' DURING ",ABPAMLDT," >>>"
End DoDot:1
GOTO A3
+6 ;
A4 SET %ZIS("A")="Select LABEL PRINTER DEVICE: "
SET %IS="P"
WRITE !
DO ^%ZIS
+1 IF $DATA(IO("S"))=1
XECUTE ^%ZIS(2,IO("S"),11)
+2 KILL %ZIS("A"),%IS
IF +IO=0
GOTO A3
+3 USE IO(0)
WRITE !!,"Please make sure labels have been put into the printer."
+4 USE IO(0)
WRITE !,"Press [RETURN] when you are ready... "
READ X:DTIME
+5 IF '$TEST
GOTO A6
USE IO(0)
WRITE !!
+6 ;
A5 SET FLBL=""
SET RR=0
FOR I=1:1
Begin DoDot:1
+1 KILL NAME,ADDR,CITY,STATE,ZIP,DATA
+2 SET RR=$ORDER(^ABPAMLBL(ABPADFN,"L",LOCCD,"I","AC",RR))
IF RR=""
QUIT
SET R=0
+3 SET R=$ORDER(^ABPAMLBL(ABPADFN,"L",LOCCD,"I","AC",RR,R))
IF +R=0
QUIT
+4 IF $DATA(^ABPAMLBL(ABPADFN,"L",LOCCD,"I",R,0))'=1
QUIT
+5 IF $DATA(^AUTNINS(R,0))'=1
QUIT
+6 SET NAME=$PIECE(^AUTNINS(R,0),"^")
+7 IF $DATA(^AUTNINS(R,1))=1
IF $LENGTH($PIECE(^AUTNINS(R,1),"^"))>3
Begin DoDot:2
+8 SET DATA=^AUTNINS(R,1)
End DoDot:2
+9 IF $DATA(^AUTNINS(R,1))=1
IF $LENGTH($PIECE(^AUTNINS(R,1),"^"))'>3
Begin DoDot:2
+10 SET DATA=^AUTNINS(R,0)
End DoDot:2
+11 IF $DATA(^AUTNINS(R,1))'=1
SET DATA=^AUTNINS(R,0)
+12 SET NAME(1)=$PIECE(DATA,"^")
SET ADDR=$PIECE(DATA,"^",2)
SET CITY=$PIECE(DATA,"^",3)
+13 SET STATE=""
SET PTR=$PIECE(DATA,"^",4)
+14 IF +PTR>0
IF $DATA(^DIC(5,PTR,0))=1
Begin DoDot:2
+15 SET STATE=$PIECE(^DIC(5,PTR,0),"^",2)
End DoDot:2
+16 SET ZIP=$PIECE(DATA,"^",5)
+17 IF NAME(1)'=NAME
SET NAME=NAME(1)
KILL NAME(1)
+18 IF $DATA(FLBL)=1
Begin DoDot:2
+19 FOR J=0:0
Begin DoDot:3
+20 IF $DATA(IO("S"))=1
XECUTE ^%ZIS(2,IO("S"),10)
HANG 2
+21 FOR K=1:1:2
Begin DoDot:4
+22 USE IO
WRITE NAME
+23 USE IO
WRITE !,ADDR,!,CITY,", ",STATE," ",ZIP
+24 USE IO
WRITE !!!!
End DoDot:4
+25 HANG 2
IF $DATA(IO("S"))=1
XECUTE ^%ZIS(2,IO("S"),11)
HANG 2
+26 USE IO(0)
WRITE !!,"ARE YOUR LABELS LINED UP"
SET %=2
DO YN^DICN
+27 USE IO(0)
WRITE !!
+28 IF +%'=1
Begin DoDot:4
+29 USE IO(0)
WRITE "Please adjust...press [RETURN] when ready"
+30 USE IO(0)
READ X:DTIME
USE IO(0)
WRITE !!
End DoDot:4
+31 IF +%=1
Begin DoDot:4
+32 KILL FLBL
IF $DATA(IO("S"))=1
XECUTE ^%ZIS(2,IO("S"),10)
HANG 2
End DoDot:4
End DoDot:3
IF $DATA(FLBL)'=1
QUIT
End DoDot:2
+33 FOR J=1:1:2
Begin DoDot:2
+34 USE IO
WRITE NAME,!,ADDR,!,CITY,", ",STATE," ",ZIP,!!!!
End DoDot:2
+35 HANG 1
End DoDot:1
IF RR=""
QUIT
+36 ;
A6 HANG 2
IF $DATA(IO("S"))=1
XECUTE ^%ZIS(2,IO("S"),11)
+1 XECUTE ^%ZIS("C")
KILL IOP,IO("S")
USE IO(0)
WRITE !!
+2 ;
END KILL X,Y,DIC,DIE,DA,DR,NAME,ADDR,CITY,STATE,ZIP,FLBL,ABPADFN,LOCCD,DATA
+1 KILL ABPAMLDT,I,J,K
+2 QUIT
+3 ;
ABORT WRITE !!,"ACCESS DENIED!!!"
QUIT
