ABPALBII ;PRINT INSURER MAILING LABELS (IND.); [ 04/16/91 3:17 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 (individual)" D ^ABPAHD
;
A2 K DIC,DIE,DA,DR S DIC="^AUTNINS(",DIC(0)="AEQZ" W !!! D ^DIC
G:+Y<0 END S ABPADFN=+Y,NAME=Y(0,0)
;
A3 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 A2
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 A5 U IO(0) W !!
;
A4 S FLBL="" D
.K ADDR,CITY,STATE,ZIP,DATA
.S R=ABPADFN
.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
..U IO W !,ADDR,!,CITY,", ",STATE," ",ZIP
..U IO W !!!!
;
A5 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
ABPALBII ;PRINT INSURER MAILING LABELS (IND.); [ 04/16/91 3:17 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 (individual)"
DO ^ABPAHD
+2 ;
A2 KILL DIC,DIE,DA,DR
SET DIC="^AUTNINS("
SET DIC(0)="AEQZ"
WRITE !!!
DO ^DIC
+1 IF +Y<0
GOTO END
SET ABPADFN=+Y
SET NAME=Y(0,0)
+2 ;
A3 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 A2
+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 A5
USE IO(0)
WRITE !!
+6 ;
A4 SET FLBL=""
Begin DoDot:1
+1 KILL ADDR,CITY,STATE,ZIP,DATA
+2 SET R=ABPADFN
+3 IF $DATA(^AUTNINS(R,1))=1
IF $LENGTH($PIECE(^AUTNINS(R,1),"^"))>3
Begin DoDot:2
+4 SET DATA=^AUTNINS(R,1)
End DoDot:2
+5 IF $DATA(^AUTNINS(R,1))=1
IF $LENGTH($PIECE(^AUTNINS(R,1),"^"))'>3
Begin DoDot:2
+6 SET DATA=^AUTNINS(R,0)
End DoDot:2
+7 IF $DATA(^AUTNINS(R,1))'=1
SET DATA=^AUTNINS(R,0)
+8 SET NAME(1)=$PIECE(DATA,"^")
SET ADDR=$PIECE(DATA,"^",2)
SET CITY=$PIECE(DATA,"^",3)
+9 SET STATE=""
SET PTR=$PIECE(DATA,"^",4)
+10 IF +PTR>0
IF $DATA(^DIC(5,PTR,0))=1
Begin DoDot:2
+11 SET STATE=$PIECE(^DIC(5,PTR,0),"^",2)
End DoDot:2
+12 SET ZIP=$PIECE(DATA,"^",5)
+13 IF NAME(1)'=NAME
SET NAME=NAME(1)
KILL NAME(1)
+14 IF $DATA(FLBL)=1
Begin DoDot:2
+15 FOR J=0:0
Begin DoDot:3
+16 IF $DATA(IO("S"))=1
XECUTE ^%ZIS(2,IO("S"),10)
HANG 2
+17 FOR K=1:1:2
Begin DoDot:4
+18 USE IO
WRITE NAME
+19 USE IO
WRITE !,ADDR,!,CITY,", ",STATE," ",ZIP
+20 USE IO
WRITE !!!!
End DoDot:4
+21 HANG 2
IF $DATA(IO("S"))=1
XECUTE ^%ZIS(2,IO("S"),11)
HANG 2
+22 USE IO(0)
WRITE !!,"ARE YOUR LABELS LINED UP"
SET %=2
DO YN^DICN
+23 USE IO(0)
WRITE !!
+24 IF +%'=1
Begin DoDot:4
+25 USE IO(0)
WRITE "Please adjust...press [RETURN] when ready"
+26 USE IO(0)
READ X:DTIME
USE IO(0)
WRITE !!
End DoDot:4
+27 IF +%=1
Begin DoDot:4
+28 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
+29 FOR J=1:1:2
Begin DoDot:2
+30 USE IO
WRITE NAME
+31 USE IO
WRITE !,ADDR,!,CITY,", ",STATE," ",ZIP
+32 USE IO
WRITE !!!!
End DoDot:2
End DoDot:1
+33 ;
A5 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
