| [613] | 1 | IMRIPST1 ;HCIOFO/FT-ICR POST-INIT ROUTINE ; 11/17/97 10:08
|
|---|
| 2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
|
|---|
| 3 | DQ ; Queue pharmacy archive date search
|
|---|
| 4 | K ZTUCI,ZTDTH,ZTIO,ZTSAVE
|
|---|
| 5 | S ZTRTN="RXARC^IMRIPST1"
|
|---|
| 6 | S ZTDTH=$$NOW^XLFDT(),ZTIO="",ZTDESC="ICR-RX ARCHIVE DATE SEARCH"
|
|---|
| 7 | D ^%ZTLOAD
|
|---|
| 8 | K ZTUCI,ZTDTH,ZTIO,ZTSAVE
|
|---|
| 9 | Q
|
|---|
| 10 | RXARC ; Check for outpatient pharmacy archive date and store in File 158.9
|
|---|
| 11 | S (IMRFN,IMRSAC)=0
|
|---|
| 12 | F S IMRFN=$O(^IMR(158,IMRFN)) Q:IMRFN'>0 D
|
|---|
| 13 | .S X=+^IMR(158,IMRFN,0) ;get encoded patient id
|
|---|
| 14 | .D XOR^IMRXOR Q:'$D(^DPT(X,0)) ;decode patient id
|
|---|
| 15 | .S IMRDFN=X ;use patient's dfn
|
|---|
| 16 | .S IMRACF=$$RXARC^IMRUTL(IMRDFN) ;check archive date for patient
|
|---|
| 17 | .S:IMRACF>IMRSAC IMRSAC=IMRACF ;save latest archive date
|
|---|
| 18 | .Q
|
|---|
| 19 | ;if archive date is found, then store in File 158.9
|
|---|
| 20 | I IMRSAC>0 S DA=$O(^IMR(158.9,0)) I DA>0 D
|
|---|
| 21 | .S IMRSAC=IMRSAC\1
|
|---|
| 22 | .S DIE="^IMR(158.9,",DR="99///"_IMRSAC
|
|---|
| 23 | .D ^DIE
|
|---|
| 24 | .Q
|
|---|
| 25 | K DA,DIE,DR,IMRDFN,IMRFN,IMRSAC
|
|---|
| 26 | Q
|
|---|
| 27 | AAAD ; Find all File 158 records where the AGE AT AIDS DIAGNOSIS (#15.8)
|
|---|
| 28 | ; is a negative value. Calculate the correct value or change to null.
|
|---|
| 29 | S IMRNODE=$G(^IMR(158,IMRX1,2))
|
|---|
| 30 | Q:$P(IMRNODE,U,16)>0
|
|---|
| 31 | S $P(IMRNODE,U,16)=""
|
|---|
| 32 | S X2=$P($G(^IMR(158,IMRX1,0)),U,35)
|
|---|
| 33 | I X2'>0 S X2=$P($G(^IMR(158,IMRX1,0)),U,23)
|
|---|
| 34 | I IMRDOB,X2 S IMRAAAD=$$AGE^IMRUTL(IMRDOB,X2)
|
|---|
| 35 | I $G(IMRAAAD) S $P(IMRNODE,U,16)=IMRAAAD
|
|---|
| 36 | S ^IMR(158,IMRX1,2)=IMRNODE
|
|---|
| 37 | Q
|
|---|
