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