| 1 | DGPMV322 ;ALB/MIR - DELETE INCOMPLETE ASIH XFR ; JUL 15 90@8
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | UNDO ;if timeout during creation of ASIH admit, back out movements and correct PTF
|
|---|
| 4 | W !!,*7,*7,"Time-out during ASIH movement...now deleting transfer and admission"
|
|---|
| 5 | S DGPMAI=$P(DGPMA,"^",14),DGPMAA=$S($D(^DGPM(+DGPMAI,0)):^(0),1:"")
|
|---|
| 6 | S DGPMADMI=$S($D(^DGPM(+DGPMDA,0)):$P(^(0),"^",15),1:""),DA=DGPMDA,DIK="^DGPM(" D ^DIK S ^UTILITY("DGPM",$J,2,DGPMDA,"A")="" ;delete xfr
|
|---|
| 7 | S DGPMPTF=$S($D(^DGPM(+DGPMADMI,0)):$P(^(0),"^",16),1:""),DA=DGPMADMI D ^DIK S ^UTILITY("DGPM",$J,1,DGPMADMI,"A")="" ;delete hospital admission
|
|---|
| 8 | S DA=DGPMPTF,DIK="^DGPT(" D ^DIK ;delete PTF for hosp admission
|
|---|
| 9 | I $P(DGPMA,"^",18)=13 D DEL^DGPMV331 ;delete NHCU or DOM discharge, fix PTF/admission record
|
|---|
| 10 | K DGPMAA,DGPMADMI,DGPMAI,DGPMPTF Q
|
|---|
