| 1 | IMRNTL1 ;HIOFOC/NCA,FT-Immunology National Data Base Inquiry (Cont.) ;9/24/97 11:36
|
|---|
| 2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
|
|---|
| 3 | PA ; Patient Inquiry
|
|---|
| 4 | D REQUEST
|
|---|
| 5 | S IMRC=IMRC+1,^TMP($J,"IMRX",IMRC)="PA"_"^"_IMRSSN
|
|---|
| 6 | D SEND
|
|---|
| 7 | Q
|
|---|
| 8 | CAT ; Breakdown of Patient by Category
|
|---|
| 9 | D REQUEST
|
|---|
| 10 | S IMRC=IMRC+1,^TMP($J,"IMRX",IMRC)="CAT"_"^"_IMRSD_"^"_IMRED_"^"_IMRTEST_"^"_IMRMC_"^"_IMRDL
|
|---|
| 11 | D SEND
|
|---|
| 12 | Q
|
|---|
| 13 | LAB ; Laboratory Utilization Data Report
|
|---|
| 14 | D REQUEST
|
|---|
| 15 | S IMRC=IMRC+1,^TMP($J,"IMRX",IMRC)="LAB"_"^"_IMRSD_"^"_IMRED_"^"_IMRN1_"^"_IMR2C_"^"_IMRRMAX_"^"_IMRDL
|
|---|
| 16 | D SEND
|
|---|
| 17 | Q
|
|---|
| 18 | PH ; Pharmacy Prescription Utilization Data Report
|
|---|
| 19 | D REQUEST
|
|---|
| 20 | S IMRC=IMRC+1,^TMP($J,"IMRX",IMRC)="PH"_"^"_IMRSD_"^"_IMRED_"^"_IMRN1_"^"_IMRN2_"^"_IMR2C_"^"_IMRRMAX_"^"_IMRDL
|
|---|
| 21 | D SEND
|
|---|
| 22 | Q
|
|---|
| 23 | FOL ; Follow Up Report
|
|---|
| 24 | D REQUEST
|
|---|
| 25 | S IMRC=IMRC+1,^TMP($J,"IMRX",IMRC)="FOL"_"^"_IMRDAY_"^"_IMRDL
|
|---|
| 26 | D SEND
|
|---|
| 27 | Q
|
|---|
| 28 | LABS ; Utilization of Specific Lab Test Report
|
|---|
| 29 | D REQUEST
|
|---|
| 30 | S IMRC=IMRC+1,^TMP($J,"IMRX",IMRC)="LABS"_"^"_IMRSD_"^"_IMRED_"^"_IMRDL
|
|---|
| 31 | F IMRRI=0:0 S IMRRI=$O(^TMP($J,"IMRLAB",IMRRI)) Q:IMRRI<1 S IMRX=$P($G(^LAB(60,IMRRI,0)),"^",1) I IMRX'="" S IMRC=IMRC+1,^TMP($J,"IMRX",IMRC)="LA"_"^"_IMRX
|
|---|
| 32 | D SEND
|
|---|
| 33 | Q
|
|---|
| 34 | PHS ; Drug Specification Utilization Report
|
|---|
| 35 | D REQUEST
|
|---|
| 36 | S IMRC=IMRC+1,^TMP($J,"IMRX",IMRC)="PHS"_"^"_IMRSD_"^"_IMRED_"^"_IMRDL
|
|---|
| 37 | F IMRRI=0:0 S IMRRI=$O(^TMP($J,"IMRRX",IMRRI)) Q:IMRRI<1 S IMRX=$$GET1^DIQ(50,IMRRI,.01,"E") I IMRX'="" S IMRC=IMRC+1,^TMP($J,"IMRX",IMRC)="DRUG"_"^"_IMRX
|
|---|
| 38 | D SEND
|
|---|
| 39 | Q
|
|---|
| 40 | REQUEST ; Build First Line
|
|---|
| 41 | I '$D(IMRSTN) D IMROPN^IMRXOR Q:'$D(IMRSTN)
|
|---|
| 42 | K ^TMP($J,"IMRX")
|
|---|
| 43 | W !!,"Sending Request Message to the National Registry..."
|
|---|
| 44 | S IMRC=1,^TMP($J,"IMRX",IMRC)="REQUEST"_"^"_IMRSTN_"^"_DT_"^"_DUZ_"^"_$P($G(^VA(200,DUZ,0)),"^",1)
|
|---|
| 45 | Q
|
|---|
| 46 | SEND ; Send Message To National Registry
|
|---|
| 47 | S X="N",%DT="T" D ^%DT S IMRDTT=Y,IMRSET=1
|
|---|
| 48 | D DOMAIN^IMRUTL ;get the domain name for ICR
|
|---|
| 49 | S IMRDOMN="S.IMRHDATA@"_IMRDOMN ;append domain to server name
|
|---|
| 50 | K XMY
|
|---|
| 51 | F IMRGI=0:0 S IMRGI=$O(^IMR(158.9,1,1,IMRGI)) Q:IMRGI'>0 I $P(^(IMRGI,0),"^",2)=1 S XMY(+^(0))=""
|
|---|
| 52 | S XMTEXT="^TMP($J,""IMRX"",",XMSUB="IMMUNOLOGY REPORT REQUEST. "_IMRSTN_" "_$E(IMRDTT,4,5)_"-"_$E(IMRDTT,6,7)_"-"_$E(IMRDTT,2,3)_" ("_IMRSET_")",XMDUZ=.5,XMY(IMRDOMN)="" D ^XMD
|
|---|
| 53 | W !,"Done..."
|
|---|
| 54 | K ^TMP($J,"IMRX"),IMRDOMN,XMTEXT,XMDUZ,XMY,XMSUB,IMRGI
|
|---|
| 55 | Q
|
|---|
