source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRNTL1.m@ 846

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1IMRNTL1 ;HIOFOC/NCA,FT-Immunology National Data Base Inquiry (Cont.) ;9/24/97 11:36
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
3PA ; Patient Inquiry
4 D REQUEST
5 S IMRC=IMRC+1,^TMP($J,"IMRX",IMRC)="PA"_"^"_IMRSSN
6 D SEND
7 Q
8CAT ; 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
13LAB ; 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
18PH ; 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
23FOL ; Follow Up Report
24 D REQUEST
25 S IMRC=IMRC+1,^TMP($J,"IMRX",IMRC)="FOL"_"^"_IMRDAY_"^"_IMRDL
26 D SEND
27 Q
28LABS ; 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
34PHS ; 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
40REQUEST ; 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
46SEND ; 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
Note: See TracBrowser for help on using the repository browser.