- ECX324MH ;ALB/JAP - PATCH ECX*3*24 Post-Install for MTL ; June 3, 1999
- ;;3.0;DSS EXTRACTS;**24**;Dec 22, 1997
- ;
- EN ;Entry point
- ;update file #727.5 with new record data
- N DIC,DIE,DA,DR,DLAYGO,X,Y,DATA,DATE,IEN,HEAD,MAX,NAME,ECX,ECXX
- D MES^XPDUTL("Updating DSS MH TESTS file (#727.5) with data based on")
- D MES^XPDUTL("your site's MH INSTRUMENT file (#601)...")
- D MES^XPDUTL(" ")
- F ECX=1:1 S ECXX=$P($T(TEXT+ECX),";;",2) Q:ECXX="QUIT" D
- .S IEN=$P(ECXX,";",1),DATA=$P(ECXX,";",2),NAME=$P(DATA,U,1),DATE=$P(DATA,U,2)
- .S DIC="^YTT(601,",DIC(0)="XO",X=NAME D ^DIC
- .Q:Y=-1
- .K X,Y,DD,DO S DIC="^ECX(727.5,",DIC(0)="L",DLAYGO=727.5,X=NAME,DINUM=IEN
- .D FILE^DICN
- .I Y=-1 D Q
- ..I $D(^ECX(727.5,IEN)),$P(^ECX(727.5,IEN,0),U)=NAME D Q
- ...D MES^XPDUTL(" Entry #"_IEN_" for "_NAME_" already exists in File #727.5.")
- ...D MES^XPDUTL(" ")
- ..D MES^XPDUTL(" WARNING: Could not update entry #"_IEN_" for "_NAME_" in File #727.5.")
- ..D MES^XPDUTL(" Please consult with NVS for DSS EXTRACTS support.")
- ..D MES^XPDUTL(" ")
- .D MES^XPDUTL(" Setting record #"_IEN_" for the "_NAME_" in File #727.5 ...")
- .K X,Y,DD,DO,DINUM
- .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
- .D FILE^DICN
- .D MES^XPDUTL(" ok.")
- .D MES^XPDUTL(" ")
- Q
- ;
- TEXT ;data for file #727.5 records
- ;;1;CRS^2991001
- ;;2;ZUNG^2991001
- ;;3;BDI^2991001
- ;;4;CAGE^2991001
- ;;5;DOM80^2991001
- ;;6;DOM81^2991001
- ;;7;DOM82^2991001
- ;;8;DOMG^2991001
- ;;QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX324MH 1542 printed Apr 23, 2025@18:04:20 Page 2
- ECX324MH ;ALB/JAP - PATCH ECX*3*24 Post-Install for MTL ; June 3, 1999
- +1 ;;3.0;DSS EXTRACTS;**24**;Dec 22, 1997
- +2 ;
- EN ;Entry point
- +1 ;update file #727.5 with new record data
- +2 NEW DIC,DIE,DA,DR,DLAYGO,X,Y,DATA,DATE,IEN,HEAD,MAX,NAME,ECX,ECXX
- +3 DO MES^XPDUTL("Updating DSS MH TESTS file (#727.5) with data based on")
- +4 DO MES^XPDUTL("your site's MH INSTRUMENT file (#601)...")
- +5 DO MES^XPDUTL(" ")
- +6 FOR ECX=1:1
- SET ECXX=$PIECE($TEXT(TEXT+ECX),";;",2)
- if ECXX="QUIT"
- QUIT
- Begin DoDot:1
- +7 SET IEN=$PIECE(ECXX,";",1)
- SET DATA=$PIECE(ECXX,";",2)
- SET NAME=$PIECE(DATA,U,1)
- SET DATE=$PIECE(DATA,U,2)
- +8 SET DIC="^YTT(601,"
- SET DIC(0)="XO"
- SET X=NAME
- DO ^DIC
- +9 if Y=-1
- QUIT
- +10 KILL X,Y,DD,DO
- SET DIC="^ECX(727.5,"
- SET DIC(0)="L"
- SET DLAYGO=727.5
- SET X=NAME
- SET DINUM=IEN
- +11 DO FILE^DICN
- +12 IF Y=-1
- Begin DoDot:2
- +13 IF $DATA(^ECX(727.5,IEN))
- IF $PIECE(^ECX(727.5,IEN,0),U)=NAME
- Begin DoDot:3
- +14 DO MES^XPDUTL(" Entry #"_IEN_" for "_NAME_" already exists in File #727.5.")
- +15 DO MES^XPDUTL(" ")
- End DoDot:3
- QUIT
- +16 DO MES^XPDUTL(" WARNING: Could not update entry #"_IEN_" for "_NAME_" in File #727.5.")
- +17 DO MES^XPDUTL(" Please consult with NVS for DSS EXTRACTS support.")
- +18 DO MES^XPDUTL(" ")
- End DoDot:2
- QUIT
- +19 DO MES^XPDUTL(" Setting record #"_IEN_" for the "_NAME_" in File #727.5 ...")
- +20 KILL X,Y,DD,DO,DINUM
- +21 SET DIC="^ECX(727.5,"_IEN_",1,"
- SET DIC(0)="L"
- SET DLAYGO=727.51
- SET DIC("P")=$PIECE(^DD(727.5,1,0),U,2)
- SET DA(1)=IEN
- SET DA=1
- SET X=DATE
- +22 DO FILE^DICN
- +23 DO MES^XPDUTL(" ok.")
- +24 DO MES^XPDUTL(" ")
- End DoDot:1
- +25 QUIT
- +26 ;
- TEXT ;data for file #727.5 records
- +1 ;;1;CRS^2991001
- +2 ;;2;ZUNG^2991001
- +3 ;;3;BDI^2991001
- +4 ;;4;CAGE^2991001
- +5 ;;5;DOM80^2991001
- +6 ;;6;DOM81^2991001
- +7 ;;7;DOM82^2991001
- +8 ;;8;DOMG^2991001
- +9 ;;QUIT
