- AICDGRP2 ; IHS/OHPRD/GIS - SUPERGROUPER DRGs REG-DAK/AVAMC 2/27/83 ;
- ;;3.51;IHS ICD/CPT lookup & grouper;;MAY 30, 1991
- ;ADT VERSION 3.32 ;FEB 15 1986
- ; MODIFIED AGAIN BY GIS/IHS/TPA 1/4/87 AND 6/6/88
- ;
- K AICDQUIT
- ASK R !!,"Age: ",AGE:60 G QQ:"^"[AGE!('$T) G ASK:'+AGE
- SEX R !,"Sex (M or F): ",SEX:60 G QQ:"^"[SEX!('$T) I SEX'="M"&(SEX'="F") W *7,!!,"Enter M for male or F for female" G SEX
- CHECK W !,"Did patient die, transfer, or sign out AMA" S %=2 D YN^DICN G QQ:%<0 I '% W !,"Answer Yes or No" G CHECK
- I %=2 S (EXP,TRS,DAM)=0 Q
- ALIVE W !,"Did patient die during this episode" S %=2 D YN^DICN G QQ:X=%<0 I '% W !,"Answer Yes or No" G ALIVE
- S EXP=$S(%=1:1,1:0) K DGFLG I EXP=1 S (TRS,DAM)=0 Q
- TRS W !,"Discharge to transfer" S %=2 D YN^DICN G QQ:%<0 I '% W !!,"Enter 'Y' if the patient was discharged to transfer, 'N' if not.",!,*7 G TRS
- S TRS=$S(%=1:1,1:0),TAC=0 G DAM:'TRS
- TAC W !,"Transfer to an acute care facility" S %=2 D YN^DICN G QQ:%<0 I '% W !!,"Enter 'Y' if the patient was transfered to an acute care facility, 'N' if not.",!,*7 G TAC
- S TAC=$S(%=1:1,1:0) Q
- DAM W !,"Discharged against medical advice" S %=2 D YN^DICN G QQ:%<0 I '% W !!,"Enter 'Y' if the patient left against medical advice, 'N' if not.",!,*7 G DAM
- S DAM=$S(%=1:1,1:0)
- Q:$D(DGFLG)
- Q
- Q S DGQU=1 Q
- QQ S AICDQUIT="" Q
- AICDGRP2 ; IHS/OHPRD/GIS - SUPERGROUPER DRGs REG-DAK/AVAMC 2/27/83 ;
- +1 ;;3.51;IHS ICD/CPT lookup & grouper;;MAY 30, 1991
- +2 ;ADT VERSION 3.32 ;FEB 15 1986
- +3 ; MODIFIED AGAIN BY GIS/IHS/TPA 1/4/87 AND 6/6/88
- +4 ;
- +5 KILL AICDQUIT
- ASK READ !!,"Age: ",AGE:60
- IF "^"[AGE!('$TEST)
- GOTO QQ
- IF '+AGE
- GOTO ASK
- SEX READ !,"Sex (M or F): ",SEX:60
- IF "^"[SEX!('$TEST)
- GOTO QQ
- IF SEX'="M"&(SEX'="F")
- WRITE *7,!!,"Enter M for male or F for female"
- GOTO SEX
- CHECK WRITE !,"Did patient die, transfer, or sign out AMA"
- SET %=2
- DO YN^DICN
- IF %<0
- GOTO QQ
- IF '%
- WRITE !,"Answer Yes or No"
- GOTO CHECK
- +1 IF %=2
- SET (EXP,TRS,DAM)=0
- QUIT
- ALIVE WRITE !,"Did patient die during this episode"
- SET %=2
- DO YN^DICN
- IF X=%<0
- GOTO QQ
- IF '%
- WRITE !,"Answer Yes or No"
- GOTO ALIVE
- +1 SET EXP=$SELECT(%=1:1,1:0)
- KILL DGFLG
- IF EXP=1
- SET (TRS,DAM)=0
- QUIT
- TRS WRITE !,"Discharge to transfer"
- SET %=2
- DO YN^DICN
- IF %<0
- GOTO QQ
- IF '%
- WRITE !!,"Enter 'Y' if the patient was discharged to transfer, 'N' if not.",!,*7
- GOTO TRS
- +1 SET TRS=$SELECT(%=1:1,1:0)
- SET TAC=0
- IF 'TRS
- GOTO DAM
- TAC WRITE !,"Transfer to an acute care facility"
- SET %=2
- DO YN^DICN
- IF %<0
- GOTO QQ
- IF '%
- WRITE !!,"Enter 'Y' if the patient was transfered to an acute care facility, 'N' if not.",!,*7
- GOTO TAC
- +1 SET TAC=$SELECT(%=1:1,1:0)
- QUIT
- DAM WRITE !,"Discharged against medical advice"
- SET %=2
- DO YN^DICN
- IF %<0
- GOTO QQ
- IF '%
- WRITE !!,"Enter 'Y' if the patient left against medical advice, 'N' if not.",!,*7
- GOTO DAM
- +1 SET DAM=$SELECT(%=1:1,1:0)
- +2 IF $DATA(DGFLG)
- QUIT
- +3 QUIT
- Q SET DGQU=1
- QUIT
- QQ SET AICDQUIT=""
- QUIT
