ABPVTINS.m

ABPVTINS ;Add/Edit Insurer File Data;[ 07/15/91  3:03 PM ]

 ;;1.34;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991

 W !!,"<<< NOT AN ENTRY POINT - ACCESS DENIED >>>",!! Q

HEAD ;

 ;PROCEDURE TO DRAW THE SCREEN HEADING

 S X="Add/Edit Insurer File Data" D SCREEN^ABPVZMM

 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 ABPV("DFN")=0,ABPV("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 ABPV("QUIT")="" Q

 S ABPV("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 '"_ABPV("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 ABPV("DFN")=DA

 S ABPV("DFN")=ABPV("DFN")+1,ABPV("LOCKED")=0

LOCK F ABPVI=0:1:9 L ^AUTNINS(ABPV("DFN")):1 I $T S ABPV("LOCKED")=1 Q

 I 'ABPV("LOCKED") D  S Y=-1 H 3 G XIT

 .W !,*7,"INSURER File is LOCKED by another USER, INSURER NOT CREATED!"

 S X=ABPV("X"),DIC="^AUTNINS(",DIC(0)="L",DINUM=ABPV("DFN") K DD,DO

 D FILE^DICN I +Y<1 W *7,!!,"ERROR: INSURER NOT CREATED",!! H 3 Q

 ;

EDIT S DA=ABPV("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 ABPV("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,^ABPVDIN 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 ABPVI=2:1:5 S $P(^(1),"^",ABPVI)=""

 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,ABPV("MODE"),ABPV("DFN"),ABPV("LOCKED"),X,Y

 K ABPV("X"),DD,DO,ABPV("QUIT"),ABPVI,AFLG,LBL

 Q

 ;

KILL I ABPV("MODE") S DIK=DIE D ^DIK

 K ABPVMESS S ABPVMESS="Data Incomplete: Entry Deleted" W *7

 S ABPVMESS(2)="... Press any key to continue ... " D PAUSE^ABPVZMM

 Q

MAIN ;

 ;ENTRY POINT - THE PRIMARY ROUTINE DRIVER

 D XIT,HEAD,WARN,ADD I $D(ABPV("QUIT"))'=1 G MAIN

 K ABPV("QUIT") Q

ABPVTINS  ;Add/Edit Insurer File Data;[ 07/15/91  3:03 PM ]

 +1       ;;1.34;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991

 +2        WRITE !!,"<<< NOT AN ENTRY POINT - ACCESS DENIED >>>",!!

           QUIT 

HEAD      ;

 +1       ;PROCEDURE TO DRAW THE SCREEN HEADING

 +2        SET X="Add/Edit Insurer File Data"

           DO SCREEN^ABPVZMM

 +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 ABPV("DFN")=0

           SET ABPV("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 ABPV("QUIT")=""

               QUIT 

 +5        SET ABPV("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 '"_ABPV("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 ABPV("DFN")=DA

 +1        SET ABPV("DFN")=ABPV("DFN")+1

           SET ABPV("LOCKED")=0

LOCK       FOR ABPVI=0:1:9

               LOCK ^AUTNINS(ABPV("DFN")):1

               IF $TEST

                   SET ABPV("LOCKED")=1

                   QUIT 

 +1        IF 'ABPV("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=ABPV("X")

           SET DIC="^AUTNINS("

           SET DIC(0)="L"

           SET DINUM=ABPV("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=ABPV("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 ABPV("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 ^ABPVDIN

           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 ABPVI=2:1:5

                   SET $PIECE(^(1),"^",ABPVI)=""

 +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,ABPV("MODE"),ABPV("DFN"),ABPV("LOCKED"),X,Y

 +1        KILL ABPV("X"),DD,DO,ABPV("QUIT"),ABPVI,AFLG,LBL

 +2        QUIT 

 +3       ;

KILL       IF ABPV("MODE")

               SET DIK=DIE

               DO ^DIK

 +1        KILL ABPVMESS

           SET ABPVMESS="Data Incomplete: Entry Deleted"

           WRITE *7

 +2        SET ABPVMESS(2)="... Press any key to continue ... "

           DO PAUSE^ABPVZMM

 +3        QUIT 

MAIN      ;

 +1       ;ENTRY POINT - THE PRIMARY ROUTINE DRIVER

 +2        DO XIT

           DO HEAD

           DO WARN

           DO ADD

           IF $DATA(ABPV("QUIT"))'=1

               GOTO MAIN

 +3        KILL ABPV("QUIT")

           QUIT