source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMV322.m@ 1424

Last change on this file since 1424 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 807 bytes
Line 
1DGPMV322 ;ALB/MIR - DELETE INCOMPLETE ASIH XFR ; JUL 15 90@8
2 ;;5.3;Registration;;Aug 13, 1993
3UNDO ;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
Note: See TracBrowser for help on using the repository browser.