- 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
