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 ;
