ABPVEEIN ;ADD/EDIT ENTRY IN INSURER FILE;[ 06/04/91 12:18 PM ]
;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
I '$D(DTIME) S DTIME=300
I $D(DUZ(2))=0 S DUZ(2)=$P(^AUTTSITE(1,0),"^",1)
I +DUZ(2)<1 S DUZ(2)=$P(^AUTTSITE(1,0),"^",1)
S SITENAME=$P(^DIC(4,DUZ(2),0),"^",1)
S Y=DT D D S DATE=Y
G START
;
HEAD K ABPV("HD") S X="Enter/Edit Insurer" D SCREEN^ABPVZMM
Q
;
SET S DIC="^AUTNINS(",DIC(0)="AELMQZ" W ! D ^DIC G:Y=-1 END
S (DA,D0)=+Y I +$P(Y,"^",3)'=1 G DISP
W !!,"<----------HOME OFFICE ADDRESS---------->"
S DIE="^AUTNINS(",DA=+Y,DR=".02;.03;.04;.06;.09",DIE("NO^")="" W ! D ^DIE
W !!,"<------------BILLING ADDRESS------------>"
K ^DIE("NO^") S DR=1 W ! D ^DIE I X=""!(X="^") G DISP
S DIE("NO^")="" F DR=2:1:5 D ^DIE I X="" W !?3,*7,"REQUIRED INFORMATION - PLEASE RESPOND!" S DR=DR-1
;S DR="1;I X="""" S Y="""";2;3;4;5;I X="""" W !?5,*7,""ZIP CODE REQUIRED - PLEASE RESPOND"" S Y=5" W ! D ^DIE
DISP K DXS D HEAD,^ABPVDIN K DXS
SELECT W !,"CHANGE which item? (1-12) OR ""^"" TO EXIT// " R X:DTIME
G END:X="^",START:X=""
I +X=0!(+X<1)!(+X>12) W *7,!," PLEASE ENTER A NUMBER FROM ""1"" TO ""12"" ONLY." G SELECT
S LBL="X"_X,DIE="^AUTNINS(" W ! D @LBL G DISP
;
X1 S DR=.01 D ^DIE Q
X2 S DR=.02 D ^DIE Q
X3 S DR=.03 D ^DIE Q
X4 S DR=.04 D ^DIE Q
X5 S DR=.05 D ^DIE Q
X6 S DR=.06 D ^DIE Q
X7 S DR=.09 D ^DIE Q
X8 S DR=1 I $D(^AUTNINS(DA,1))=0 S DR=DR_";I X=""^""!(X="""") S Y="""",AFLG="""";5"
K AFLG D ^DIE I $D(AFLG)=1 K AFLG Q
X8A I $P(^AUTNINS(DA,1),"^",1)'=""&($P(^AUTNINS(DA,1),"^",5)="") W !?3,*7,"REQUIRED INFORMATION - PLEASE RESPOND!" S DR=5 D ^DIE G X8A
I $P(^AUTNINS(DA,1),"^",1)="" K ^AUTNINS(DA,1)
Q
X9 S DR=2 D ^DIE Q
X10 S DR=3 D ^DIE Q
X11 S DR=4 D ^DIE Q
X12 S DR=5 D ^DIE Q
;
START W @IOF D HEAD G SET
END K NAME,STREET,CITY,STATE,ZIP,PHONE,DR,DATE,DA,DFN,SITENAME,ABPV("HD")
Q
D I $L(Y)'<7 S %=$E(Y,4,5)*3,Y=$E("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",%-2,%)_" "_$S($E(Y,6,7):$J(+$E(Y,6,7),2)_",",1:"")_($E(Y,1,3)+1700)_$S(Y[".":" "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),1:"") Q
ABPVEEIN ;ADD/EDIT ENTRY IN INSURER FILE;[ 06/04/91 12:18 PM ]
+1 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
+2 IF '$DATA(DTIME)
SET DTIME=300
+3 IF $DATA(DUZ(2))=0
SET DUZ(2)=$PIECE(^AUTTSITE(1,0),"^",1)
+4 IF +DUZ(2)<1
SET DUZ(2)=$PIECE(^AUTTSITE(1,0),"^",1)
+5 SET SITENAME=$PIECE(^DIC(4,DUZ(2),0),"^",1)
+6 SET Y=DT
DO D
SET DATE=Y
+7 GOTO START
+8 ;
HEAD KILL ABPV("HD")
SET X="Enter/Edit Insurer"
DO SCREEN^ABPVZMM
+1 QUIT
+2 ;
SET SET DIC="^AUTNINS("
SET DIC(0)="AELMQZ"
WRITE !
DO ^DIC
IF Y=-1
GOTO END
+1 SET (DA,D0)=+Y
IF +$PIECE(Y,"^",3)'=1
GOTO DISP
+2 WRITE !!,"<----------HOME OFFICE ADDRESS---------->"
+3 SET DIE="^AUTNINS("
SET DA=+Y
SET DR=".02;.03;.04;.06;.09"
SET DIE("NO^")=""
WRITE !
DO ^DIE
+4 WRITE !!,"<------------BILLING ADDRESS------------>"
+5 KILL ^DIE("NO^")
SET DR=1
WRITE !
DO ^DIE
IF X=""!(X="^")
GOTO DISP
+6 SET DIE("NO^")=""
FOR DR=2:1:5
DO ^DIE
IF X=""
WRITE !?3,*7,"REQUIRED INFORMATION - PLEASE RESPOND!"
SET DR=DR-1
+7 ;S DR="1;I X="""" S Y="""";2;3;4;5;I X="""" W !?5,*7,""ZIP CODE REQUIRED - PLEASE RESPOND"" S Y=5" W ! D ^DIE
DISP KILL DXS
DO HEAD
DO ^ABPVDIN
KILL DXS
SELECT WRITE !,"CHANGE which item? (1-12) OR ""^"" TO EXIT// "
READ X:DTIME
+1 IF X="^"
GOTO END
IF X=""
GOTO START
+2 IF +X=0!(+X<1)!(+X>12)
WRITE *7,!," PLEASE ENTER A NUMBER FROM ""1"" TO ""12"" ONLY."
GOTO SELECT
+3 SET LBL="X"_X
SET DIE="^AUTNINS("
WRITE !
DO @LBL
GOTO DISP
+4 ;
X1 SET DR=.01
DO ^DIE
QUIT
X2 SET DR=.02
DO ^DIE
QUIT
X3 SET DR=.03
DO ^DIE
QUIT
X4 SET DR=.04
DO ^DIE
QUIT
X5 SET DR=.05
DO ^DIE
QUIT
X6 SET DR=.06
DO ^DIE
QUIT
X7 SET DR=.09
DO ^DIE
QUIT
X8 SET DR=1
IF $DATA(^AUTNINS(DA,1))=0
SET DR=DR_";I X=""^""!(X="""") S Y="""",AFLG="""";5"
+1 KILL AFLG
DO ^DIE
IF $DATA(AFLG)=1
KILL AFLG
QUIT
X8A IF $PIECE(^AUTNINS(DA,1),"^",1)'=""&($PIECE(^AUTNINS(DA,1),"^",5)="")
WRITE !?3,*7,"REQUIRED INFORMATION - PLEASE RESPOND!"
SET DR=5
DO ^DIE
GOTO X8A
+1 IF $PIECE(^AUTNINS(DA,1),"^",1)=""
KILL ^AUTNINS(DA,1)
+2 QUIT
X9 SET DR=2
DO ^DIE
QUIT
X10 SET DR=3
DO ^DIE
QUIT
X11 SET DR=4
DO ^DIE
QUIT
X12 SET DR=5
DO ^DIE
QUIT
+1 ;
START WRITE @IOF
DO HEAD
GOTO SET
END KILL NAME,STREET,CITY,STATE,ZIP,PHONE,DR,DATE,DA,DFN,SITENAME,ABPV("HD")
+1 QUIT
D IF $LENGTH(Y)'<7
SET %=$EXTRACT(Y,4,5)*3
SET Y=$EXTRACT("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",%-2,%)_" "_$SELECT">SELECT($EXTRACT(Y,6,7):$JUSTIFY(+$EXTRACT(Y,6,7),2)_",",1:"")_($EXTRACT(Y,1,3)+1700)_$SELECT">SELECT(Y[".":" "_$EXTRACT(Y_0,9,10)_":"_$EXTRACT(Y_"000",11,12),1:"")
QUIT
