ACHSDAR3 ; IHS/ITSC/PMF - APPEAL TO ALTERNATE RESOURCE (1/3) ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
PAT ;
S ACHDOCT="appeal to alternate resource"
D ^ACHSDLK ;STANDARD PATIENT LOOKUP
G END^ACHSDAR4:$D(ACHDLKER)
P4 ;
;IF 'OTHER RESOURCES' ARE DOCUMENTED
I $P($G(^ACHSDEN(DUZ(2),"D",ACHSA,800,0)),U,4) G P5
W !!!,*7,*7,?10,"No Alternate Resources For This Patient. ",!
G ENTER:$$DIR^ACHS("Y"," Do You Wish To Enter One Now ","NO","Enter 'YES' to enter an Alternate Resource for this patient","",2)
S ACHDLKER=""
D END^ACHSDAR4 Q
;
P5 ;
I $P($G(^ACHSDEN(DUZ(2),"D",ACHSA,800,0)),U,4)=1 S ACHDALRS=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,800,0)),U,3) G DENDT
;
W !!?10,"Alternate Resources Available For This Patient.",!!
S (ACHD,ACHDX)=0
F S ACHD=$O(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHD)) Q:'ACHD D
.S ACHDX=ACHDX+1
.W ?13,ACHDX,". ",$P($G(^AUTNINS($P($G(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHD,0)),U),0)),U),!
;
S %=$$DIR^ACHS("N^1:"_ACHDX," Select Alternate Resource","","","",1)
I $D(DUOUT)!$D(DTOUT)!('%) G PAT
S ACHDALRS=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,800,+%,0)),U)
;
DENDT ; --- Date Of Alternate Resource Denial"
W !!
S ACHDDAT=$$FMTE^XLFDT($P($G(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,0)),U,5))
;
S %=$$DIR^ACHS("D","Enter Date Of Alternate Resource Denial",$S($D(ACHDDAT):ACHDDAT,1:""),"","",1)
I $D(DUOUT)!$D(DTOUT) G PAT
I +%<0 G OPTION
S DA=ACHDALRS
S DA(1)=ACHSA
S DA(2)=DUZ(2)
S DIE="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",800,"
S DR="8////"_+%
I '$$LOCK^ACHS("^ACHSDEN(DUZ(2),""D"",ACHSA,800,ACHDALRS)","+") S DUOUT="" Q
D ^DIE
I '$$LOCK^ACHS("^ACHSDEN(DUZ(2),""D"",ACHSA,800,ACHDALRS)","-") S DUOUT="" Q
;
OPTION ; --- Appeal Options
W !!!?10,"Appeal Options",!
;
S (ACHD,ACHDX)=0
F S ACHDX=$O(^ACHSDENR(DUZ(2),13,ACHDX)) Q:+ACHDX=0 D
.S ACHD=ACHD+1 W !?10,ACHD_". ",$P($G(^ACHSDENR(DUZ(2),13,ACHDX,0)),U)
;
I ACHD=0 W !,"No Appeal options found for this facility!" G ALRCMT
;
S %=$$DIR^ACHS("NO^1:"_ACHD," Enter Number Of Option Or <RETURN> To Continue","","","",1)
;
G ALRCMT:%=""
I $D(DUOUT)!$D(DTOUT) D END^ACHSDAR4 Q
;
I '$D(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,4,0)) S ^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,4,0)=$$ZEROTH^ACHS(9002071,1,800,9)
;
I %=ACHD S DIC="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",800,"_ACHDALRS_",4,",DA(3)=DUZ(2),DA(2)=ACHSA,DA(1)=ACHDALRS D EN^DIWE G OPTION
;
S X=%
S DIC="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",800,"_ACHDALRS_",4,"
S DA(3)=DUZ(2)
S DA(2)=ACHSA
S DA(1)=ACHDALRS
S DIC(0)="QEMZ"
;
K DD,DO
D FILE^DICN ;
G OPTION
;
ALRCMT ; --- Comments Concerning Alternate Resource Appeal
W !!,"Enter Pertinent Comments Concerning Alternate Resource Appeal",!,"Or <RETURN> to Skip: ",!!
S DIC="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",800,"_ACHDALRS_",5,"
S DA(3)=DUZ(2)
S DA(2)=ACHSA
S DA(1)=ACHDALRS
D EN^DIWE
I X[U S ACHDLKER=""
DEV ;
W !!
S %ZIS="OPQ"
D ^%ZIS
I POP D HOME^%ZIS D END^ACHSDAR4 Q
G:'$D(IO("Q")) START^ACHSDAR4
K IO("Q")
I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
S ZTRTN="START^ACHSDAR4",ZTDESC="CHS APPEAL TO ALTERNATE RESOURCE LETTER"
F %="ACHSA","ACHDALRS" S ZTSAVE(%)=""
D ^%ZTLOAD G:'$D(ZTSK) DEV
Q
;
ENTER ;
W !!
I '$D(^ACHSDEN(DUZ(2),"D",ACHSA,800,0)) S ^ACHSDEN(DUZ(2),"D",ACHSA,800,0)=$$ZEROTH^ACHS(9002071,1,800)
S DA(2)=DUZ(2)
S DA(1)=ACHSA
S DIC="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",800,"
S DIC(0)="AQELM"
D ^DIC
G:Y<1 P4
W !!
S DA(2)=DUZ(2)
S DA(1)=ACHSA
S DIE=DIC
S DR="2;5"
D ^DIE
G P4
;
ACHSDAR3 ; IHS/ITSC/PMF - APPEAL TO ALTERNATE RESOURCE (1/3) ; [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
PAT ;
+1 SET ACHDOCT="appeal to alternate resource"
+2 ;STANDARD PATIENT LOOKUP
DO ^ACHSDLK
+3 IF $DATA(ACHDLKER)
GOTO END^ACHSDAR4
P4 ;
+1 ;IF 'OTHER RESOURCES' ARE DOCUMENTED
+2 IF $PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,800,0)),U,4)
GOTO P5
+3 WRITE !!!,*7,*7,?10,"No Alternate Resources For This Patient. ",!
+4 IF $$DIR^ACHS("Y"," Do You Wish To Enter One Now ","NO","Enter 'YES' to enter an Alternate Resource for this patient","",2)
GOTO ENTER
+5 SET ACHDLKER=""
+6 DO END^ACHSDAR4
QUIT
+7 ;
P5 ;
+1 IF $PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,800,0)),U,4)=1
SET ACHDALRS=$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,800,0)),U,3)
GOTO DENDT
+2 ;
+3 WRITE !!?10,"Alternate Resources Available For This Patient.",!!
+4 SET (ACHD,ACHDX)=0
+5 FOR
SET ACHD=$ORDER(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHD))
IF 'ACHD
QUIT
Begin DoDot:1
+6 SET ACHDX=ACHDX+1
+7 WRITE ?13,ACHDX,". ",$PIECE($GET(^AUTNINS($PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHD,0)),U),0)),U),!
End DoDot:1
+8 ;
+9 SET %=$$DIR^ACHS("N^1:"_ACHDX," Select Alternate Resource","","","",1)
+10 IF $DATA(DUOUT)!$DATA(DTOUT)!('%)
GOTO PAT
+11 SET ACHDALRS=$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,800,+%,0)),U)
+12 ;
DENDT ; --- Date Of Alternate Resource Denial"
+1 WRITE !!
+2 SET ACHDDAT=$$FMTE^XLFDT($PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,0)),U,5))
+3 ;
+4 SET %=$$DIR^ACHS("D","Enter Date Of Alternate Resource Denial",$SELECT($DATA(ACHDDAT):ACHDDAT,1:""),"","",1)
+5 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO PAT
+6 IF +%<0
GOTO OPTION
+7 SET DA=ACHDALRS
+8 SET DA(1)=ACHSA
+9 SET DA(2)=DUZ(2)
+10 SET DIE="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",800,"
+11 SET DR="8////"_+%
+12 IF '$$LOCK^ACHS("^ACHSDEN(DUZ(2),""D"",ACHSA,800,ACHDALRS)","+")
SET DUOUT=""
QUIT
+13 DO ^DIE
+14 IF '$$LOCK^ACHS("^ACHSDEN(DUZ(2),""D"",ACHSA,800,ACHDALRS)","-")
SET DUOUT=""
QUIT
+15 ;
OPTION ; --- Appeal Options
+1 WRITE !!!?10,"Appeal Options",!
+2 ;
+3 SET (ACHD,ACHDX)=0
+4 FOR
SET ACHDX=$ORDER(^ACHSDENR(DUZ(2),13,ACHDX))
IF +ACHDX=0
QUIT
Begin DoDot:1
+5 SET ACHD=ACHD+1
WRITE !?10,ACHD_". ",$PIECE($GET(^ACHSDENR(DUZ(2),13,ACHDX,0)),U)
End DoDot:1
+6 ;
+7 IF ACHD=0
WRITE !,"No Appeal options found for this facility!"
GOTO ALRCMT
+8 ;
+9 SET %=$$DIR^ACHS("NO^1:"_ACHD," Enter Number Of Option Or <RETURN> To Continue","","","",1)
+10 ;
+11 IF %=""
GOTO ALRCMT
+12 IF $DATA(DUOUT)!$DATA(DTOUT)
DO END^ACHSDAR4
QUIT
+13 ;
+14 IF '$DATA(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,4,0))
SET ^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,4,0)=$$ZEROTH^ACHS(9002071,1,800,9)
+15 ;
+16 IF %=ACHD
SET DIC="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",800,"_ACHDALRS_",4,"
SET DA(3)=DUZ(2)
SET DA(2)=ACHSA
SET DA(1)=ACHDALRS
DO EN^DIWE
GOTO OPTION
+17 ;
+18 SET X=%
+19 SET DIC="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",800,"_ACHDALRS_",4,"
+20 SET DA(3)=DUZ(2)
+21 SET DA(2)=ACHSA
+22 SET DA(1)=ACHDALRS
+23 SET DIC(0)="QEMZ"
+24 ;
+25 KILL DD,DO
+26 ;
DO FILE^DICN
+27 GOTO OPTION
+28 ;
ALRCMT ; --- Comments Concerning Alternate Resource Appeal
+1 WRITE !!,"Enter Pertinent Comments Concerning Alternate Resource Appeal",!,"Or <RETURN> to Skip: ",!!
+2 SET DIC="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",800,"_ACHDALRS_",5,"
+3 SET DA(3)=DUZ(2)
+4 SET DA(2)=ACHSA
+5 SET DA(1)=ACHDALRS
+6 DO EN^DIWE
+7 IF X[U
SET ACHDLKER=""
DEV ;
+1 WRITE !!
+2 SET %ZIS="OPQ"
+3 DO ^%ZIS
+4 IF POP
DO HOME^%ZIS
DO END^ACHSDAR4
QUIT
+5 IF '$DATA(IO("Q"))
GOTO START^ACHSDAR4
+6 KILL IO("Q")
+7 IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
WRITE *7,!,"Please queue to system printers."
DO ^%ZISC
GOTO DEV
+8 SET ZTRTN="START^ACHSDAR4"
SET ZTDESC="CHS APPEAL TO ALTERNATE RESOURCE LETTER"
+9 FOR %="ACHSA","ACHDALRS"
SET ZTSAVE(%)=""
+10 DO ^%ZTLOAD
IF '$DATA(ZTSK)
GOTO DEV
+11 QUIT
+12 ;
ENTER ;
+1 WRITE !!
+2 IF '$DATA(^ACHSDEN(DUZ(2),"D",ACHSA,800,0))
SET ^ACHSDEN(DUZ(2),"D",ACHSA,800,0)=$$ZEROTH^ACHS(9002071,1,800)
+3 SET DA(2)=DUZ(2)
+4 SET DA(1)=ACHSA
+5 SET DIC="^ACHSDEN("_DUZ(2)_",""D"","_ACHSA_",800,"
+6 SET DIC(0)="AQELM"
+7 DO ^DIC
+8 IF Y<1
GOTO P4
+9 WRITE !!
+10 SET DA(2)=DUZ(2)
+11 SET DA(1)=ACHSA
+12 SET DIE=DIC
+13 SET DR="2;5"
+14 DO ^DIE
+15 GOTO P4
+16 ;
