ABPATINS ;Add/Edit Insurer File Data;[ 07/10/91 8:20 PM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
W !!,"<<< NOT AN ENTRY POINT - ACCESS DENIED >>>",!! Q
HEAD ;
;PROCEDURE TO DRAW THE SCREEN HEADING
S ABPAHD1="Add/Edit Insurer File Data" D HEADER^ABPAMAIN
Q
WARN ;
;PROCEDURE TO ISSUE FILE MAINTENANCE RESPONSIBILITY WARINING
W !!,"WARNING: Before ADDING a new INSURER you should "
W "ensure that it does not",!?9,"already exist!"
Q
ADD ;
;PROCEDURE TO ADD A NEW INSURER FILE ENTRY
S ABPA("DFN")=0,ABPA("MODE")=1,DA=+$P(^AUTNINS(0),"^",3)-1
W ! K DIR S DIR(0)="FO",DIR("A")="Enter the NAME of the INSURER"
D ^DIR K DIR I $D(DIRUT) D XIT S ABPA("QUIT")="" Q
S ABPA("X")=X D G DISP:+Y>0
.K DIC S DIC="^AUTNINS(",DIC(0)="EM" D ^DIC K DIC Q:+Y'>0
.S ABM("DFN")=+Y,DA=+Y,D0=+Y,ABM("MODE")=0
W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to Add '"_ABPA("X")
S DIR("A")=DIR("A")_"' as a New INSURER",DIR("B")="NO" W *7 D ^DIR
K DIR Q:$D(DUOUT)!$D(DTOUT)!(Y<1) W !,"OK, adding..."
DFN F S DA=$O(^AUTNINS(DA)) Q:'+DA S ABPA("DFN")=DA
S ABPA("DFN")=ABPA("DFN")+1,ABPA("LOCKED")=0
LOCK F ABPAI=0:1:9 L ^AUTNINS(ABPA("DFN")):1 I $T S ABPA("LOCKED")=1 Q
I 'ABPA("LOCKED") D S Y=-1 H 3 G XIT
.W !,*7,"INSURER File is LOCKED by another USER, INSURER NOT CREATED!"
S X=ABPA("X"),DIC="^AUTNINS(",DIC(0)="L",DINUM=ABPA("DFN") K DD,DO
D FILE^DICN I +Y<1 W *7,!!,"ERROR: INSURER NOT CREATED",!! H 3 Q
;
EDIT S DA=ABPA("DFN"),DIE="^AUTNINS(" ;I $P($G(^AUTNINS(DA,1)),U,7)=2 G ADDR
W ! S DR=".01R~Insurer Name.......: ;.41R~Long Lookup Name...: "
D ^DIE G KILL:$D(Y)
ADDR W !!,"<--------------- MAILING ADDRESS --------------->"
S DR=".02R~Street...: ;.03R~City.....: ;.04R~State....: ;.05R~Zip "
S DR=DR_"Code.: " D ^DIE G KILL:$D(Y) S ABPA("MODE")=0
W !!,"<--------------- BILLING ADDRESS --------------->",!?6
W "(if Different than Mailing Address)"
S DR="1Billing Office.: ;I X="""" S Y=""@9"";2 Street.: ;"
S DR=DR_"3 City...: ;4 State..: ;5 Zip....: ;@9"
D ^DIE G KILL:$D(Y)
DISP K DXS D ^%AUCLS,HEAD,^ABPADIN K DXS
SELECT W !,"CHANGE which item? (1-12)// " R X:DTIME
Q:X["^"!(X']"") I +X<1!(+X>12) D G SELECT
.W *7,!," PLEASE ENTER A NUMBER FROM ""1"" TO ""12"" ONLY."
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 D
.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)="") D
.W !?3,*7,"REQUIRED INFORMATION - PLEASE RESPOND!" S DR=5 D ^DIE G X8A
I $P(^AUTNINS(DA,1),"^",1)="" F ABPAI=2:1:5 S $P(^(1),"^",ABPAI)=""
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
;
XIT L K DA,DIC,DIE,DR,ABPA("MODE"),ABPA("DFN"),ABPA("LOCKED"),X,Y
K ABPA("X"),DD,DO,ABPA("QUIT"),ABPAI,AFLG,LBL
Q
;
KILL I ABPA("MODE") S DIK=DIE D ^DIK
K ABPAMESS S ABPAMESS="Data Incomplete: Entry Deleted" W *7
S ABPAMESS(2)="... Press any key to continue ... " D PAUSE^ABPAMAIN
Q
MAIN ;
;ENTRY POINT - THE PRIMARY ROUTINE DRIVER
D XIT,HEAD,WARN,ADD I $D(ABPA("QUIT"))'=1 G MAIN
K ABPA("QUIT") Q
ABPATINS ;Add/Edit Insurer File Data;[ 07/10/91 8:20 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
+2 WRITE !!,"<<< NOT AN ENTRY POINT - ACCESS DENIED >>>",!!
QUIT
HEAD ;
+1 ;PROCEDURE TO DRAW THE SCREEN HEADING
+2 SET ABPAHD1="Add/Edit Insurer File Data"
DO HEADER^ABPAMAIN
+3 QUIT
WARN ;
+1 ;PROCEDURE TO ISSUE FILE MAINTENANCE RESPONSIBILITY WARINING
+2 WRITE !!,"WARNING: Before ADDING a new INSURER you should "
+3 WRITE "ensure that it does not",!?9,"already exist!"
+4 QUIT
ADD ;
+1 ;PROCEDURE TO ADD A NEW INSURER FILE ENTRY
+2 SET ABPA("DFN")=0
SET ABPA("MODE")=1
SET DA=+$PIECE(^AUTNINS(0),"^",3)-1
+3 WRITE !
KILL DIR
SET DIR(0)="FO"
SET DIR("A")="Enter the NAME of the INSURER"
+4 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
DO XIT
SET ABPA("QUIT")=""
QUIT
+5 SET ABPA("X")=X
Begin DoDot:1
+6 KILL DIC
SET DIC="^AUTNINS("
SET DIC(0)="EM"
DO ^DIC
KILL DIC
IF +Y'>0
QUIT
+7 SET ABM("DFN")=+Y
SET DA=+Y
SET D0=+Y
SET ABM("MODE")=0
End DoDot:1
IF +Y>0
GOTO DISP
+8 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to Add '"_ABPA("X")
+9 SET DIR("A")=DIR("A")_"' as a New INSURER"
SET DIR("B")="NO"
WRITE *7
DO ^DIR
+10 KILL DIR
IF $DATA(DUOUT)!$DATA(DTOUT)!(Y<1)
QUIT
WRITE !,"OK, adding..."
DFN FOR
SET DA=$ORDER(^AUTNINS(DA))
IF '+DA
QUIT
SET ABPA("DFN")=DA
+1 SET ABPA("DFN")=ABPA("DFN")+1
SET ABPA("LOCKED")=0
LOCK FOR ABPAI=0:1:9
LOCK ^AUTNINS(ABPA("DFN")):1
IF $TEST
SET ABPA("LOCKED")=1
QUIT
+1 IF 'ABPA("LOCKED")
Begin DoDot:1
+2 WRITE !,*7,"INSURER File is LOCKED by another USER, INSURER NOT CREATED!"
End DoDot:1
SET Y=-1
HANG 3
GOTO XIT
+3 SET X=ABPA("X")
SET DIC="^AUTNINS("
SET DIC(0)="L"
SET DINUM=ABPA("DFN")
KILL DD,DO
+4 DO FILE^DICN
IF +Y<1
WRITE *7,!!,"ERROR: INSURER NOT CREATED",!!
HANG 3
QUIT
+5 ;
EDIT ;I $P($G(^AUTNINS(DA,1)),U,7)=2 G ADDR
SET DA=ABPA("DFN")
SET DIE="^AUTNINS("
+1 WRITE !
SET DR=".01R~Insurer Name.......: ;.41R~Long Lookup Name...: "
+2 DO ^DIE
IF $DATA(Y)
GOTO KILL
ADDR WRITE !!,"<--------------- MAILING ADDRESS --------------->"
+1 SET DR=".02R~Street...: ;.03R~City.....: ;.04R~State....: ;.05R~Zip "
+2 SET DR=DR_"Code.: "
DO ^DIE
IF $DATA(Y)
GOTO KILL
SET ABPA("MODE")=0
+3 WRITE !!,"<--------------- BILLING ADDRESS --------------->",!?6
+4 WRITE "(if Different than Mailing Address)"
+5 SET DR="1Billing Office.: ;I X="""" S Y=""@9"";2 Street.: ;"
+6 SET DR=DR_"3 City...: ;4 State..: ;5 Zip....: ;@9"
+7 DO ^DIE
IF $DATA(Y)
GOTO KILL
DISP KILL DXS
DO ^%AUCLS
DO HEAD
DO ^ABPADIN
KILL DXS
SELECT WRITE !,"CHANGE which item? (1-12)// "
READ X:DTIME
+1 IF X["^"!(X']"")
QUIT
IF +X<1!(+X>12)
Begin DoDot:1
+2 WRITE *7,!," PLEASE ENTER A NUMBER FROM ""1"" TO ""12"" ONLY."
End DoDot:1
GOTO SELECT
+3 SET LBL="X"_X
SET DIE="^AUTNINS("
WRITE !
DO @LBL
GOTO DISP
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
Begin DoDot:1
+1 SET DR=DR_";I X=""^""!(X="""") S Y="""",AFLG="""";5"
End DoDot:1
+2 KILL AFLG
DO ^DIE
IF $DATA(AFLG)=1
KILL AFLG
QUIT
X8A IF $PIECE(^AUTNINS(DA,1),"^",1)'=""&($PIECE(^AUTNINS(DA,1),"^",5)="")
Begin DoDot:1
+1 WRITE !?3,*7,"REQUIRED INFORMATION - PLEASE RESPOND!"
SET DR=5
DO ^DIE
GOTO X8A
End DoDot:1
+2 IF $PIECE(^AUTNINS(DA,1),"^",1)=""
FOR ABPAI=2:1:5
SET $PIECE(^(1),"^",ABPAI)=""
+3 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 ;
XIT LOCK
KILL DA,DIC,DIE,DR,ABPA("MODE"),ABPA("DFN"),ABPA("LOCKED"),X,Y
+1 KILL ABPA("X"),DD,DO,ABPA("QUIT"),ABPAI,AFLG,LBL
+2 QUIT
+3 ;
KILL IF ABPA("MODE")
SET DIK=DIE
DO ^DIK
+1 KILL ABPAMESS
SET ABPAMESS="Data Incomplete: Entry Deleted"
WRITE *7
+2 SET ABPAMESS(2)="... Press any key to continue ... "
DO PAUSE^ABPAMAIN
+3 QUIT
MAIN ;
+1 ;ENTRY POINT - THE PRIMARY ROUTINE DRIVER
+2 DO XIT
DO HEAD
DO WARN
DO ADD
IF $DATA(ABPA("QUIT"))'=1
GOTO MAIN
+3 KILL ABPA("QUIT")
QUIT
