source: FOIAVistA/trunk/r/GEN_MED_REC_VITALS-GMRV/GMRVXPRE.m@ 1328

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1GMRVXPRE ;HIRMFO/RM-PREINITIALIZATION ROUTINE FOR VITALS ;7/19/96
2 ;;4.0;Vitals/Measurements;;Apr 25, 1997
3EN1 ; PRE-INITIALIZATION FOR THE VITALS PACKAGE
4 S GMRVER=$$VERSION^XPDUTL("GMRV") I +GMRVER=0 K GMRVER Q
5 I $$GET1^DID(120.5,1.4,"","LABEL")="*COMMENTS" D
6 . D BMES^XPDUTL("Deleting *COMMENTS field from 120.5 file...")
7 . S DA(1)=120.5,DA=1.4,DIK="^DD(120.5," D ^DIK
8 . Q
9 S (GMRVC,GMRVDA)=0 F S GMRVDA=$O(^GMRD(120.51,GMRVDA)) Q:GMRVDA'>0 D
10 . S GMRVHELP=$P($G(^GMRD(120.51,GMRVDA,0)),"^",6) Q:GMRVHELP'>0
11 . S GMRVHELP=$$GET1^DIQ(9.2,GMRVHELP_",",.01,"I") Q:GMRVHELP=""
12 . K GMRVFDA S GMRVFDA(99,120.51,GMRVDA_",",5)=GMRVHELP
13 . D FILE^DIE("","GMRVFDA(99)") I '$D(^TMP("DIERR",$J)),'GMRVC D
14 . . S GMRVC=1
15 . . D BMES^XPDUTL("Converting HELP FRAME data in 120.51 file...")
16 . . Q
17 . K ^TMP("DIERR",$J)
18 . Q
19 F GMRVFILE=120.52,120.53 D
20 . S GMRVFNM=$$GET1^DID(GMRVFILE,"","","NAME")
21 . S GMRVFINF=$P($T(@$P(GMRVFILE,".",2)),";;",2)
22 . I GMRVFNM=$P(GMRVFINF,";") D
23 . . S GMRVFNM=$P(GMRVFINF,";",2)
24 . . D BMES^XPDUTL("Changing name of file #"_GMRVFILE_" to "_GMRVFNM)
25 . . K DA,DIE,DR
26 . . S DIE="^DIC(",DA=GMRVFILE,DR=".01///^S X=GMRVFNM" D ^DIE
27 . . Q
28 . Q
29 D DELXREF(120.5,.01,"AA")
30 D DELXREF(120.5,.02,"AZ1")
31 D DELXREF(120.5,.03,"AZ2")
32 K GMRVFLD S GMRVDD="READ ACCESS;WRITE ACCESS;DELETE ACCESS"
33 D FIELD^DID(120.53,.01,"",GMRVDD,"GMRVFLD(120.53,.01)")
34 D FIELD^DID(120.53,1,"",GMRVDD,"GMRVFLD(120.53,1)")
35 D FIELD^DID(120.531,.01,"",GMRVDD,"GMRVFLD(120.531,.01)")
36 S GMRVFILE=0 F S GMRVFILE=$O(GMRVFLD(GMRVFILE)) Q:GMRVFILE'>0 D
37 . S GMRVFLD=0 F S GMRVFLD=$O(GMRVFLD(GMRVFILE,GMRVFLD)) Q:GMRVFLD'>0 F GMRVDD="READ ACCESS^8","WRITE ACCESS^9","DELETE ACCESS^8.5" D
38 . . S GMRVACC=$P(GMRVDD,"^")
39 . . I $G(GMRVFLD(GMRVFILE,GMRVFLD,GMRVACC))="^" D
40 . . . D BMES^XPDUTL("Removing "_GMRVACC_" for "_GMRVFLD_" field of "_GMRVFILE_" file/sub-file...")
41 . . . K ^DD(GMRVFILE,GMRVFLD,$P(GMRVDD,"^",2))
42 . . . Q
43 . . Q
44 . Q
45 D EN^GMRVXCH0
46 K DA,DIE,DIK,DR,GMRVACC,GMRVC,GMRVDA,GMRVDD,GMRVER,GMRVFDA,GMRVFILE
47 K GMRVFINF,GMRVFLD,GMRVFNM,GMRVHELP
48 Q
49FILES ;;Old File Name;New File Name
5052 ;;GMRV VITAL SITE;GMRV VITAL QUALIFIER
5153 ;;GMRV VITAL QUALITY;GMRV VITAL CATEGORY
52 Q
53DELXREF(GMRVFILE,GMRVFLD,GMRVIX) ; This procedure will delete the
54 ; cross-refernce for specified file and field.
55 ; Input variables: GMRVFILE=file number
56 ; GMRVFLD=field number
57 ; GMRVIX=xref name
58 ;
59 N GMRV1,GMRVIXDA
60 S (GMRV1,GMRVIXDA)=0
61 F S GMRVIXDA=$O(^DD(GMRVFILE,GMRVFLD,1,GMRVIXDA)) Q:GMRVIXDA'>0 D
62 . I $P($G(^DD(GMRVFILE,GMRVFLD,1,GMRVIXDA,0)),"^",2)=GMRVIX D
63 . . I 'GMRV1 D
64 . . . S GMRV1=1
65 . . . D BMES^XPDUTL("Deleting """_GMRVIX_""" xref for "_GMRVFLD_" field of "_GMRVFILE_" file...")
66 . . . Q
67 . . K ^DD(GMRVFILE,0,"IX",GMRVIX,GMRVFILE,GMRVFLD)
68 . . K ^DD(GMRVFILE,GMRVFLD,1,GMRVIXDA)
69 . . Q
70 . Q
71 Q
Note: See TracBrowser for help on using the repository browser.