| 1 | ECX324MH ;ALB/JAP - PATCH ECX*3*24 Post-Install for MTL ; June 3, 1999
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**24**;Dec 22, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;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 | ;
|
|---|
| 31 | TEXT ;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
|
|---|
