| 1 | NURAAU3 ;HIRMFO/RM,MD-PURGE MODULE...AMIS A1106 ;2/27/98  14:20
 | 
|---|
| 2 |  ;;4.0;NURSING SERVICE;**9**;Apr 25, 1997
 | 
|---|
| 3 |  ; LAST MODIFIED BY MD;/10/26/92
 | 
|---|
| 4 |  ; DONE BY: NURAAU0
 | 
|---|
| 5 | EN1 ; PURGE AMIS ACUITY DATA
 | 
|---|
| 6 |  ; PURGE YEARLY (RETAIN 4 FISCAL YEARS) FROM FILE 213.4
 | 
|---|
| 7 |  ;
 | 
|---|
| 8 |  S NURPLSW=1
 | 
|---|
| 9 |  S PURGDATE=($E(DT,1,3)-4)_"1001" S REC="" F NURSI=0:0 S REC=$O(^NURSA(213.4,"B",REC)) Q:'($E(REC,1,7)<PURGDATE)  S DA=$O(^NURSA(213.4,"B",REC,0)),DIK="^NURSA(213.4," W:'$D(ZTQUEUED) "." D ^DIK
 | 
|---|
| 10 |  K NURPLSW Q
 | 
|---|
| 11 | EXCP ; FILE EXCEPTION REPORT DATA
 | 
|---|
| 12 |  I $S(NURTYPE=1:1,1:0) G 1
 | 
|---|
| 13 |  S:'$D(^NURSA(213.5,NEXCDA,1,0)) ^NURSA(213.5,NEXCDA,1,0)="^213.51P^^"
 | 
|---|
| 14 |  S ^NURSA(213.5,NEXCDA,1,DFN,0)=DFN_"^"_NWARD,$P(^NURSA(213.5,NEXCDA,1,0),"^",3,4)=DFN_"^"_($P(^NURSA(213.5,NEXCDA,1,0),"^",4)+1),DA(1)=NEXCDA,DA=DFN,DIK="^NURSA(213.5,DA(1),1," D IX1^DIK
 | 
|---|
| 15 |  S DIE="^NURSA(213.5,DA(1),1,",DR="2///^S X=NERR;3///^S X=NURSX;4///^S X=CLSDATE" D ^DIE Q
 | 
|---|
| 16 | 1 Q:NERR(1)=""  S:'$D(^NURSA(213.5,NEXCDA(1),1,0)) ^NURSA(213.5,NEXCDA(1),1,0)="^213.51P^^"
 | 
|---|
| 17 |  S ^NURSA(213.5,NEXCDA(1),1,DFN,0)=DFN_"^"_NWARD,$P(^NURSA(213.5,NEXCDA(1),1,0),"^",3,4)=DFN_"^"_($P(^NURSA(213.5,NEXCDA(1),1,0),"^",4)+1),DA(1)=NEXCDA(1),DA=DFN,DIK="^NURSA(213.5,DA(1),1," D IX1^DIK
 | 
|---|
| 18 |  S DIE="^NURSA(213.5,DA(1),1,",DR="2///^S X=NERR(1);3///^S X=NURSX;4///^S X=CLSDATE" D ^DIE
 | 
|---|
| 19 |  Q
 | 
|---|
| 20 | EN2 ; ENTRY TO PURGE FILE 213.5 DATA OLDER THAN 30 DAYS AND CREATE TODAYS NODES
 | 
|---|
| 21 |  S X="T-30",%DT="" D ^%DT S NURSJ=+Y
 | 
|---|
| 22 |  S DIK="^NURSA(213.5," F NURSI=0:0 S NURSI=$O(^NURSA(213.5,"B",NURSI)) Q:NURSI'>0  F DA=0:0 S DA=$O(^NURSA(213.5,"B",NURSI,DA)) Q:DA'>0  I '(NURSI>NURSJ) W:'$D(ZTQUEUED) "." D ^DIK
 | 
|---|
| 23 |  L +^NURSA(213.5)
 | 
|---|
| 24 |  F NURTYPE=0,1 S X=RPTDATE,DLAYGO=213.5,DIC="^NURSA(213.5,",DIC(0)="L",DIC("DR")=".02///^S X=NURTYPE",DIC("S")="I $P(^(0),U,2)=NURTYPE" D ^DIC K DIC,DLAYGO S:NURTYPE=0 NEXCDA=+Y S:NURTYPE=1 NEXCDA(1)=+Y
 | 
|---|
| 25 |  L -^NURSA(213.5) S:+Y'>0 NUROUTSW=1 Q:NUROUTSW
 | 
|---|
| 26 |  K NURTYPE
 | 
|---|
| 27 |  Q
 | 
|---|
| 28 | HEMCOUNT ; HEMODIALYSIS COUNT UPDATE
 | 
|---|
| 29 |  S BEDSECT=$O(^NURSF(213.3,"B","HEMODIALYSIS","")),NURS1=0
 | 
|---|
| 30 |  I $L(BEDSECT)=1 S BEDSECT="0"_BEDSECT
 | 
|---|
| 31 |  F NCWARD=0:0 S NCWARD=$O(^NURSA(214.6,"ACNT",RPTDATE,NCWARD)) Q:NCWARD'>0  F NURSI=0:0 S NURSI=$O(^NURSA(214.6,"ACNT",RPTDATE,NCWARD,"H",NURSI)) Q:NURSI'>0  S NURS1=NURS1+1 D HMRCPROC S NURS1=0
 | 
|---|
| 32 |  Q
 | 
|---|
| 33 | RECOUNT ; RECOVERY ROOM COUNT UPDATE
 | 
|---|
| 34 |  S BEDSECT=$O(^NURSF(213.3,"B","RECOVERY ROOM","")),NURS1=0
 | 
|---|
| 35 |  I $L(BEDSECT)=1 S BEDSECT="0"_BEDSECT
 | 
|---|
| 36 |  F NCWARD=0:0 S NCWARD=$O(^NURSA(214.6,"ACNT",RPTDATE,NCWARD)) Q:NCWARD'>0  F NURSI=0:0 S NURSI=$O(^NURSA(214.6,"ACNT",RPTDATE,NCWARD,"R",NURSI)) Q:NURSI'>0  S NURS1=NURS1+1 D HMRCPROC S NURS1=0
 | 
|---|
| 37 |  Q
 | 
|---|
| 38 | HMRCPROC ; PROCESS RECOVERY/ROOM AND HEMODALYSIS COUNTS
 | 
|---|
| 39 |  S REC=RPTDATE_BEDSECT_NCWARD F I=1:1:5 S NCLASS(I)=0
 | 
|---|
| 40 |  S NCLASS(1)=NURS1 D FINALLY^NURAAU0
 | 
|---|
| 41 |  Q
 | 
|---|