ACHSDN3.m

ACHSDN3 ; IHS/ITSC/PMF - DENIAL EDIT PROVIDERS ;  [ 02/12/2002  10:19 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**3**;JUN 11, 2001

 ;ACHS*3.1*3  remove the 'other providers' node correctly

 ;

A ;

 Q:$D(DUOUT)

 W @IOF,?33,"PROVIDER EDITS",!,$$REPEAT^XLFSTR("=",79),!,"PRIMARY PROVIDER....",!

 K ACHDSP

 S A=$G(^ACHSDEN(DUZ(2),"D",ACHSA,100))

 G:$P(A,U)="Y" A2

 S ACHD("PROV",1)="N"

 W !,"   1. ",$P(A,U,3)

 G B

 ;

A2 ;

 S ACHD("PROV",1)="O",ACHD("PTR")=$P(A,U,2)

 I ACHD("PTR")]"",$D(^AUTTVNDR(ACHD("PTR"),0)) W !,"   1. ",$P($G(^AUTTVNDR(ACHD("PTR"),0)),U)

B ;

 W !!!,"OTHER PROVIDERS....",!

 S ACHD("TVNDR")=1

 G C:'$D(^ACHSDEN(DUZ(2),"D",ACHSA,200))

 ;

 ;2/8/01  pmf  ACHS*3.1*3  remove the 'other providers' node correctly

 ;I $P($G(^ACHSDEN(DUZ(2),"D",ACHSA,200,0)),U,4)=0 K ^ACHSDEN(DUZ(2),"D",ACHSA,0) G C ; ACHS*3.1*3

 I $P($G(^ACHSDEN(DUZ(2),"D",ACHSA,200,0)),U,4)=0 K ^ACHSDEN(DUZ(2),"D",ACHSA,200) G C ; achs*3.1*3

 ;

 S ACHD=0

B1 ;

 S ACHD=$O(^ACHSDEN(DUZ(2),"D",ACHSA,200,ACHD))

 G C:+ACHD=0

 S ACHD("PTR")=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,200,ACHD,0)),U)

 ;

 I ACHD("PTR")]"",$D(^AUTTVNDR(ACHD("PTR"),0)) S ACHD("TVNDR")=ACHD("TVNDR")+1,ACHD("PROV",ACHD("TVNDR"))="O^"_ACHD W !,"  ",ACHD("TVNDR"),". ",$P($G(^AUTTVNDR(ACHD("PTR"),0)),U) G B1

 S DIE="^ACHSDEN("_DUZ(2)_",""D"","

 S DA(2)=DUZ(2),DA(1)=ACHSA,DA=ACHD,DR=200,DR(2,9002071.02)=".01///@"

 D ^DIE

 G B1

 ;

C ;

 G D:'$D(^ACHSDEN(DUZ(2),"D",ACHSA,210))

 ;02/11/02 pmf  ACHS*3.1*3  remove the 'other providers not on file'

 ; node correctly

 ;I $P($G(^ACHSDEN(DUZ(2),"D",ACHSA,210,0)),U,4)=0 K ^ACHSDEN(DUZ(2),"D",ACHSA,0) G D  ; ACHS*3.1*3

 I $P($G(^ACHSDEN(DUZ(2),"D",ACHSA,210,0)),U,4)=0 K ^ACHSDEN(DUZ(2),"D",ACHSA,210) G D  ; ACHS*3.1*3

 ;

 F ACHD=0:0 S ACHD=$O(^ACHSDEN(DUZ(2),"D",ACHSA,210,ACHD)) Q:+ACHD=0  D

 .S ACHD("TVNDR")=ACHD("TVNDR")+1

 .S ACHD("PROV",ACHD("TVNDR"))="N^"_ACHD

 .W !,"  ",ACHD("TVNDR"),". ",$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,210,ACHD,0)),U)

 ;

D ;

 S Y=$$DIR^ACHS("FO","Edit which? (1"_$S(+ACHD("TVNDR")>1:" thru "_ACHD("TVNDR"),1:"")_", A=add a vendor, RETURN=none) ","","","^D QUES^ACHSDN3",2)

 Q:$D(DTOUT)!$D(DUOUT)!(Y="")

 G E:+Y>0&(+Y'>ACHD("TVNDR"))

 G PROV:$E(Y)="A"

 D QUES

 G D

 ;

E ;

 W !!

 I Y=1 S ACHDSP="" D PRMPRV^ACHSDN1 G A

 G E2:$P(ACHD("PROV",+Y),U)="N"

 G A:$P(ACHD("PROV",+Y),U)'="O"

 I '$$DIE(".01:99",$P(ACHD("PROV",+Y),U,2),200)

 G A

 ;

E2 ;

 I '$$DIE(".01:99",$P(ACHD("PROV",+Y),U,2),210)

 G A

 ;

PROV ;

 S Y=$$DIR^ACHS("Y","Is the new provider in the VENDOR file? ","YES","","",2)

 G A:$D(DUOUT)!$D(DTOUT),O1:Y,O2:'Y

O1 ;

 S:'$D(^ACHSDEN(DUZ(2),"D",ACHSA,200,0)) ^ACHSDEN(DUZ(2),"D",ACHSA,200,0)=$$ZEROTH^ACHS(9002071,1,200)

 S DIC="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",200,",DA(2)=DUZ(2),DA(1)=ACHSA,DIC(0)="AELMNQ"

 D ^DIC

 G:Y<1 A

 I '$$DIE(".01:99",+Y,200)

 K DA,DIC,DIE,DR

 G A

 ;

O2 ;

 S:'$D(^ACHSDEN(DUZ(2),"D",ACHSA,210,0)) ^ACHSDEN(DUZ(2),"D",ACHSA,210,0)=$$ZEROTH^ACHS(9002071,1,210)

 S DIC="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",210,",DA(1)=ACHSA,DIC(0)="QAZEML",DA(2)=DUZ(2)

 D ^DIC

 G A:+Y<1

 I '$$DIE(".01:99",+Y,210)

 G A

 ;

QUES ;EP - From DIR

 W *7,!,"Enter one of the numbers shown, or an 'A'."

 Q

 ;

DIE(DR,DA,N) ; N = Global node

 W !!

 S DA(1)=ACHSA,DA(2)=DUZ(2),DIE="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_","_N_","

 I '$$LOCK^ACHS("^ACHSDEN(DUZ(2),""D"",ACHSA)","+") S DUOUT="" Q 0

 D ^DIE

 I '$$LOCK^ACHS("^ACHSDEN(DUZ(2),""D"",ACHSA)","-") S DUOUT="" Q 0

 Q 1

 ;

ACHSDN3   ; IHS/ITSC/PMF - DENIAL EDIT PROVIDERS ;  [ 02/12/2002  10:19 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**3**;JUN 11, 2001

 +2       ;ACHS*3.1*3  remove the 'other providers' node correctly

 +3       ;

A         ;

 +1        IF $DATA(DUOUT)

               QUIT 

 +2        WRITE @IOF,?33,"PROVIDER EDITS",!,$$REPEAT^XLFSTR("=",79),!,"PRIMARY PROVIDER....",!

 +3        KILL ACHDSP

 +4        SET A=$GET(^ACHSDEN(DUZ(2),"D",ACHSA,100))

 +5        IF $PIECE(A,U)="Y"

               GOTO A2

 +6        SET ACHD("PROV",1)="N"

 +7        WRITE !,"   1. ",$PIECE(A,U,3)

 +8        GOTO B

 +9       ;

A2        ;

 +1        SET ACHD("PROV",1)="O"

           SET ACHD("PTR")=$PIECE(A,U,2)

 +2        IF ACHD("PTR")]""

               IF $DATA(^AUTTVNDR(ACHD("PTR"),0))

                   WRITE !,"   1. ",$PIECE($GET(^AUTTVNDR(ACHD("PTR"),0)),U)

B         ;

 +1        WRITE !!!,"OTHER PROVIDERS....",!

 +2        SET ACHD("TVNDR")=1

 +3        IF '$DATA(^ACHSDEN(DUZ(2),"D",ACHSA,200))

               GOTO C

 +4       ;

 +5       ;2/8/01  pmf  ACHS*3.1*3  remove the 'other providers' node correctly

 +6       ;I $P($G(^ACHSDEN(DUZ(2),"D",ACHSA,200,0)),U,4)=0 K ^ACHSDEN(DUZ(2),"D",ACHSA,0) G C ; ACHS*3.1*3

 +7       ; achs*3.1*3

           IF $PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,200,0)),U,4)=0

               KILL ^ACHSDEN(DUZ(2),"D",ACHSA,200)

               GOTO C

 +8       ;

 +9        SET ACHD=0

B1        ;

 +1        SET ACHD=$ORDER(^ACHSDEN(DUZ(2),"D",ACHSA,200,ACHD))

 +2        IF +ACHD=0

               GOTO C

 +3        SET ACHD("PTR")=$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,200,ACHD,0)),U)

 +4       ;

 +5        IF ACHD("PTR")]""

               IF $DATA(^AUTTVNDR(ACHD("PTR"),0))

                   SET ACHD("TVNDR")=ACHD("TVNDR")+1

                   SET ACHD("PROV",ACHD("TVNDR"))="O^"_ACHD

                   WRITE !,"  ",ACHD("TVNDR"),". ",$PIECE($GET(^AUTTVNDR(ACHD("PTR"),0)),U)

                   GOTO B1

 +6        SET DIE="^ACHSDEN("_DUZ(2)_",""D"","

 +7        SET DA(2)=DUZ(2)

           SET DA(1)=ACHSA

           SET DA=ACHD

           SET DR=200

           SET DR(2,9002071.02)=".01///@"

 +8        DO ^DIE

 +9        GOTO B1

 +10      ;

C         ;

 +1        IF '$DATA(^ACHSDEN(DUZ(2),"D",ACHSA,210))

               GOTO D

 +2       ;02/11/02 pmf  ACHS*3.1*3  remove the 'other providers not on file'

 +3       ; node correctly

 +4       ;I $P($G(^ACHSDEN(DUZ(2),"D",ACHSA,210,0)),U,4)=0 K ^ACHSDEN(DUZ(2),"D",ACHSA,0) G D  ; ACHS*3.1*3

 +5       ; ACHS*3.1*3

           IF $PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,210,0)),U,4)=0

               KILL ^ACHSDEN(DUZ(2),"D",ACHSA,210)

               GOTO D

 +6       ;

 +7        FOR ACHD=0:0

               SET ACHD=$ORDER(^ACHSDEN(DUZ(2),"D",ACHSA,210,ACHD))

               IF +ACHD=0

                   QUIT 

               Begin DoDot:1

 +8                SET ACHD("TVNDR")=ACHD("TVNDR")+1

 +9                SET ACHD("PROV",ACHD("TVNDR"))="N^"_ACHD

 +10               WRITE !,"  ",ACHD("TVNDR"),". ",$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,210,ACHD,0)),U)

               End DoDot:1

 +11      ;

D         ;

 +1        SET Y=$$DIR^ACHS("FO","Edit which? (1"_$SELECT(+ACHD("TVNDR")>1:" thru "_ACHD("TVNDR"),1:"")_", A=add a vendor, RETURN=none) ","","","^D QUES^ACHSDN3",2)

 +2        IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")

               QUIT 

 +3        IF +Y>0&(+Y'>ACHD("TVNDR"))

               GOTO E

 +4        IF $EXTRACT(Y)="A"

               GOTO PROV

 +5        DO QUES

 +6        GOTO D

 +7       ;

E         ;

 +1        WRITE !!

 +2        IF Y=1

               SET ACHDSP=""

               DO PRMPRV^ACHSDN1

               GOTO A

 +3        IF $PIECE(ACHD("PROV",+Y),U)="N"

               GOTO E2

 +4        IF $PIECE(ACHD("PROV",+Y),U)'="O"

               GOTO A

 +5        IF '$$DIE(".01:99",$PIECE(ACHD("PROV",+Y),U,2),200)

 +6        GOTO A

 +7       ;

E2        ;

 +1        IF '$$DIE(".01:99",$PIECE(ACHD("PROV",+Y),U,2),210)

 +2        GOTO A

 +3       ;

PROV      ;

 +1        SET Y=$$DIR^ACHS("Y","Is the new provider in the VENDOR file? ","YES","","",2)

 +2        IF $DATA(DUOUT)!$DATA(DTOUT)

               GOTO A

           IF Y

               GOTO O1

           IF 'Y

               GOTO O2

O1        ;

 +1        IF '$DATA(^ACHSDEN(DUZ(2),"D",ACHSA,200,0))

               SET ^ACHSDEN(DUZ(2),"D",ACHSA,200,0)=$$ZEROTH^ACHS(9002071,1,200)

 +2        SET DIC="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",200,"

           SET DA(2)=DUZ(2)

           SET DA(1)=ACHSA

           SET DIC(0)="AELMNQ"

 +3        DO ^DIC

 +4        IF Y<1

               GOTO A

 +5        IF '$$DIE(".01:99",+Y,200)

 +6        KILL DA,DIC,DIE,DR

 +7        GOTO A

 +8       ;

O2        ;

 +1        IF '$DATA(^ACHSDEN(DUZ(2),"D",ACHSA,210,0))

               SET ^ACHSDEN(DUZ(2),"D",ACHSA,210,0)=$$ZEROTH^ACHS(9002071,1,210)

 +2        SET DIC="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",210,"

           SET DA(1)=ACHSA

           SET DIC(0)="QAZEML"

           SET DA(2)=DUZ(2)

 +3        DO ^DIC

 +4        IF +Y<1

               GOTO A

 +5        IF '$$DIE(".01:99",+Y,210)

 +6        GOTO A

 +7       ;

QUES      ;EP - From DIR

 +1        WRITE *7,!,"Enter one of the numbers shown, or an 'A'."

 +2        QUIT 

 +3       ;

DIE(DR,DA,N) ; N = Global node

 +1        WRITE !!

 +2        SET DA(1)=ACHSA

           SET DA(2)=DUZ(2)

           SET DIE="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_","_N_","

 +3        IF '$$LOCK^ACHS("^ACHSDEN(DUZ(2),""D"",ACHSA)","+")

               SET DUOUT=""

               QUIT 0

 +4        DO ^DIE

 +5        IF '$$LOCK^ACHS("^ACHSDEN(DUZ(2),""D"",ACHSA)","-")

               SET DUOUT=""

               QUIT 0

 +6        QUIT 1

 +7       ;