ACHSDAR5 ; IHS/ITSC/PMF - APPEAL TO ALTERNATE RESOURCE (3/3) ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
; --- Provider of services
PROV ;EP from ACHSDAR1
W !?DIWL+3,"Provider of services: "
I $$DN^ACHS(100,2),$D(^AUTTVNDR($$DN^ACHS(100,2),0)) W $P($G(^AUTTVNDR($$DN^ACHS(100,2),0)),U),! G PROV1
;
;IF NOT 'PRIMARY PROVIDER (ON-FILE)' PRINT 'PRIMARY PROVIDER (NOT ON-FILE)'
I $$DN^ACHS(100,1)="N" W $$DN^ACHS(100,3),!
PROV1 ;
;LETS SEE IF THERE IS OTHER PROVIDERS ON-FILE
;
S A=0
F S A=$O(^ACHSDEN(DUZ(2),"D",ACHSA,200,A)) Q:+A=0 D Q:$G(ACHSQUIT)
.S ACHDPROV=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,200,A,0)),U)
.I ACHDPROV]"",$D(^AUTTVNDR(ACHDPROV,0)) W ?DIWL+3,"Provider of services: ",$P($G(^AUTTVNDR(ACHDPROV,0)),U),!
PROV2 ;
;
;LETS SEE IF OTHER PROVIDER NOT ON-FILE
S A=0
F S A=$O(^ACHSDEN(DUZ(2),"D",ACHSA,210,A)) Q:+A=0 D Q:$G(ACHSQUIT)
.W ?DIWL+3,"Provider of services: ",$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,210,A,0)),U),!
Q
;
ALTR ;EP --- Alternate resources
Q:$G(ACHSQUIT)
S (Y,A)=0
W ?DIWL+4,"Alternate resources: "
ALTR1 ;
Q:$G(ACHSQUIT)
S A=$O(^ACHSDEN(DUZ(2),"D",ACHSA,800,A))
;W:'A !
Q:+A=0
S X=$P($G(^AUTNINS($P($G(^ACHSDEN(DUZ(2),"D",ACHSA,800,A,0)),U),4)),U)
W !?29,X
G ALTR1
;
;GET 'OTHER IHS RESOURCES"
IHSRES ;EP from ACHSDAR1
S IHSRES=0,Y=0
F S IHSRES=$O(^ACHSDEN(DUZ(2),"D",ACHSA,825,IHSRES)) Q:'IHSRES D Q:$G(ACHSQUIT)
.S X=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,825,IHSRES,0)),U) Q:'X
.S RES=$P($G(^DIC(4,X,0)),U)
.W !?29,RES
;
Q
ENTDOC ;
I '$D(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,1,0)) S ^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,1,0)=$$ZEROTH^ACHS(9002071,1,800,4)
W !?10,"DOCUMENT TYPES ALREADY ENTERED: ",!
;
S X=0
F S X=$O(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,1,X)) Q:+X=0 D Q:$G(ACHSQUIT)
W !?10,$G(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,1,X,0))
W !!
;
S DIC="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",800,"_ACHDALRS_",1,"
S DIC(0)="AQEMLZ"
S DIC("A")="DOCUMENT TYPE: "
D ^DIC
;
S %=$$DIR^ACHS("Y","Enter Another Document Type","NO","Enter 'YES' to enter another document type","",2)
Q:('%)!$D(DUOUT)!$D(DTOUT)
G ENTDOC
;
ACHSDAR5 ; IHS/ITSC/PMF - APPEAL TO ALTERNATE RESOURCE (3/3) ; [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 ; --- Provider of services
PROV ;EP from ACHSDAR1
+1 WRITE !?DIWL+3,"Provider of services: "
+2 IF $$DN^ACHS(100,2)
IF $DATA(^AUTTVNDR($$DN^ACHS(100,2),0))
WRITE $PIECE($GET(^AUTTVNDR($$DN^ACHS(100,2),0)),U),!
GOTO PROV1
+3 ;
+4 ;IF NOT 'PRIMARY PROVIDER (ON-FILE)' PRINT 'PRIMARY PROVIDER (NOT ON-FILE)'
+5 IF $$DN^ACHS(100,1)="N"
WRITE $$DN^ACHS(100,3),!
PROV1 ;
+1 ;LETS SEE IF THERE IS OTHER PROVIDERS ON-FILE
+2 ;
+3 SET A=0
+4 FOR
SET A=$ORDER(^ACHSDEN(DUZ(2),"D",ACHSA,200,A))
IF +A=0
QUIT
Begin DoDot:1
+5 SET ACHDPROV=$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,200,A,0)),U)
+6 IF ACHDPROV]""
IF $DATA(^AUTTVNDR(ACHDPROV,0))
WRITE ?DIWL+3,"Provider of services: ",$PIECE($GET(^AUTTVNDR(ACHDPROV,0)),U),!
End DoDot:1
IF $GET(ACHSQUIT)
QUIT
PROV2 ;
+1 ;
+2 ;LETS SEE IF OTHER PROVIDER NOT ON-FILE
+3 SET A=0
+4 FOR
SET A=$ORDER(^ACHSDEN(DUZ(2),"D",ACHSA,210,A))
IF +A=0
QUIT
Begin DoDot:1
+5 WRITE ?DIWL+3,"Provider of services: ",$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,210,A,0)),U),!
End DoDot:1
IF $GET(ACHSQUIT)
QUIT
+6 QUIT
+7 ;
ALTR ;EP --- Alternate resources
+1 IF $GET(ACHSQUIT)
QUIT
+2 SET (Y,A)=0
+3 WRITE ?DIWL+4,"Alternate resources: "
ALTR1 ;
+1 IF $GET(ACHSQUIT)
QUIT
+2 SET A=$ORDER(^ACHSDEN(DUZ(2),"D",ACHSA,800,A))
+3 ;W:'A !
+4 IF +A=0
QUIT
+5 SET X=$PIECE($GET(^AUTNINS($PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,800,A,0)),U),4)),U)
+6 WRITE !?29,X
+7 GOTO ALTR1
+8 ;
+9 ;GET 'OTHER IHS RESOURCES"
IHSRES ;EP from ACHSDAR1
+1 SET IHSRES=0
SET Y=0
+2 FOR
SET IHSRES=$ORDER(^ACHSDEN(DUZ(2),"D",ACHSA,825,IHSRES))
IF 'IHSRES
QUIT
Begin DoDot:1
+3 SET X=$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,825,IHSRES,0)),U)
IF 'X
QUIT
+4 SET RES=$PIECE($GET(^DIC(4,X,0)),U)
+5 WRITE !?29,RES
End DoDot:1
IF $GET(ACHSQUIT)
QUIT
+6 ;
+7 QUIT
ENTDOC ;
+1 IF '$DATA(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,1,0))
SET ^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,1,0)=$$ZEROTH^ACHS(9002071,1,800,4)
+2 WRITE !?10,"DOCUMENT TYPES ALREADY ENTERED: ",!
+3 ;
+4 SET X=0
+5 FOR
SET X=$ORDER(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,1,X))
IF +X=0
QUIT
Begin DoDot:1
End DoDot:1
IF $GET(ACHSQUIT)
QUIT
+6 WRITE !?10,$GET(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,1,X,0))
+7 WRITE !!
+8 ;
+9 SET DIC="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",800,"_ACHDALRS_",1,"
+10 SET DIC(0)="AQEMLZ"
+11 SET DIC("A")="DOCUMENT TYPE: "
+12 DO ^DIC
+13 ;
+14 SET %=$$DIR^ACHS("Y","Enter Another Document Type","NO","Enter 'YES' to enter another document type","",2)
+15 IF ('%)!$DATA(DUOUT)!$DATA(DTOUT)
QUIT
+16 GOTO ENTDOC
+17 ;
