source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECX324MH.m@ 701

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

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1ECX324MH ;ALB/JAP - PATCH ECX*3*24 Post-Install for MTL ; June 3, 1999
2 ;;3.0;DSS EXTRACTS;**24**;Dec 22, 1997
3 ;
4EN ;Entry point
5 ;update file #727.5 with new record data
6 N DIC,DIE,DA,DR,DLAYGO,X,Y,DATA,DATE,IEN,HEAD,MAX,NAME,ECX,ECXX
7 D MES^XPDUTL("Updating DSS MH TESTS file (#727.5) with data based on")
8 D MES^XPDUTL("your site's MH INSTRUMENT file (#601)...")
9 D MES^XPDUTL(" ")
10 F ECX=1:1 S ECXX=$P($T(TEXT+ECX),";;",2) Q:ECXX="QUIT" D
11 .S IEN=$P(ECXX,";",1),DATA=$P(ECXX,";",2),NAME=$P(DATA,U,1),DATE=$P(DATA,U,2)
12 .S DIC="^YTT(601,",DIC(0)="XO",X=NAME D ^DIC
13 .Q:Y=-1
14 .K X,Y,DD,DO S DIC="^ECX(727.5,",DIC(0)="L",DLAYGO=727.5,X=NAME,DINUM=IEN
15 .D FILE^DICN
16 .I Y=-1 D Q
17 ..I $D(^ECX(727.5,IEN)),$P(^ECX(727.5,IEN,0),U)=NAME D Q
18 ...D MES^XPDUTL(" Entry #"_IEN_" for "_NAME_" already exists in File #727.5.")
19 ...D MES^XPDUTL(" ")
20 ..D MES^XPDUTL(" WARNING: Could not update entry #"_IEN_" for "_NAME_" in File #727.5.")
21 ..D MES^XPDUTL(" Please consult with NVS for DSS EXTRACTS support.")
22 ..D MES^XPDUTL(" ")
23 .D MES^XPDUTL(" Setting record #"_IEN_" for the "_NAME_" in File #727.5 ...")
24 .K X,Y,DD,DO,DINUM
25 .S DIC="^ECX(727.5,"_IEN_",1,",DIC(0)="L",DLAYGO=727.51,DIC("P")=$P(^DD(727.5,1,0),U,2),DA(1)=IEN,DA=1,X=DATE
26 .D FILE^DICN
27 .D MES^XPDUTL(" ok.")
28 .D MES^XPDUTL(" ")
29 Q
30 ;
31TEXT ;data for file #727.5 records
32 ;;1;CRS^2991001
33 ;;2;ZUNG^2991001
34 ;;3;BDI^2991001
35 ;;4;CAGE^2991001
36 ;;5;DOM80^2991001
37 ;;6;DOM81^2991001
38 ;;7;DOM82^2991001
39 ;;8;DOMG^2991001
40 ;;QUIT
Note: See TracBrowser for help on using the repository browser.