- 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 ;
