AGLKIN.m

AGLKIN ; IHS/ASDS/EFG - LOOK-UP AND EDIT INACTIVE OR DECEASED PATIENTS ; 

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

A W $$S^AGVDF("IOF") W !,"Review and edit DECEASED or INACTIVE patient files.....",!!

 S AUPNLK("INAC")="",DIC("S")="I $D(^AUPNPAT(Y,41,DUZ(2),0)) I $P(^(0),U,3)]""""!($D(^DPT(Y,.35)))" D PTLK^AG K AUPNLK("INAC")

 Q:'$D(DFN)

B K ^UTILITY("DIQ1",$J) W !!!,"DATE OF DEATH: " S DR=.351,DIC=2,DA=DFN D EN^DIQ1 I $D(^(DR)) W ^(DR)

C W !!,"INACTIVE DATE: " S DIC=9000001.41,DA=DFN,DR=.03,AG("DRENT1")=DUZ(2) D ^AGDICLK K AG("NOUPDATE") I $D(AG("LKPRINT")) W AG("LKPRINT") S AG("NOUPDATE")=""

 W !!,"RECORD DISPOSITION: " S DR=.04,AG("DRENT1")=DUZ(2) D ^AGDICLK W:$D(AG("LKPRINT")) AG("LKPRINT")

D W !!,"Do you wish to edit this patient's file? (Y/N) NO//  " D READ^AG G END:$D(DTOUT)!$D(DFOUT)!$D(DLOUT)!(Y?1"N".E),E:Y?1"Y".E,A:$D(DUOUT) D YN^AG G D

E D ^AGED1 K AG("NOUPDATE") G A

END Q

AGLKIN    ; IHS/ASDS/EFG - LOOK-UP AND EDIT INACTIVE OR DECEASED PATIENTS ; 

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

A          WRITE $$S^AGVDF("IOF")

           WRITE !,"Review and edit DECEASED or INACTIVE patient files.....",!!

 +1        SET AUPNLK("INAC")=""

           SET D">DIC("S")="I $D">D(^AUPNPAT(Y,41,D">DUZ(2),0)) I $P(^(0),U,3)]""""!($D">D(^D">DPT(Y,.35)))"

           DO PTLK^AG

           KILL AUPNLK("INAC")

 +2        IF '$DATA(DFN)

               QUIT 

B          KILL ^UTILITY("DIQ1",$JOB)

           WRITE !!!,"DATE OF DEATH: "

           SET DR=.351

           SET DIC=2

           SET DA=DFN

           DO EN^DIQ1

           IF $DATA(^(DR))

               WRITE ^(DR)

C          WRITE !!,"INACTIVE DATE: "

           SET DIC=9000001.41

           SET DA=DFN

           SET DR=.03

           SET AG("DRENT1")=DUZ(2)

           DO ^AGDICLK

           KILL AG("NOUPDATE")

           IF $DATA(AG("LKPRINT"))

               WRITE AG("LKPRINT")

               SET AG("NOUPDATE")=""

 +1        WRITE !!,"RECORD DISPOSITION: "

           SET DR=.04

           SET AG("DRENT1")=DUZ(2)

           DO ^AGDICLK

           IF $DATA(AG("LKPRINT"))

               WRITE AG("LKPRINT")

D          WRITE !!,"Do you wish to edit this patient's file? (Y/N) NO//  "

           DO READ^AG

           IF $DATA(DTOUT)!$DATA(DFOUT)!$DATA(DLOUT)!(Y?1"N".E)

               GOTO END

           IF Y?1"Y".E

               GOTO E

           IF $DATA(DUOUT)

               GOTO A

           DO YN^AG

           GOTO D

E          DO ^AGED1

           KILL AG("NOUPDATE")

           GOTO A

END        QUIT