source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMSPU1.m@ 724

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1SCMSPU1 ;ALB/JRP - AMB CARE POST INIT UTILITIES;03-JUN-1996
2 ;;5.3;Scheduling;**44**;AUG 13, 1993
3CRTAPP(HL7APP,HL7FAC,HL7MG) ;Create/find entry in HL APPLICATION file (#771)
4 ;
5 ;Input : HL7APP - Name of application to create (field #.01)
6 ; Free text - 3 to 15 characters
7 ; HL7FAC - Facility name (field #3)
8 ; Free text - 1 to 20 characters
9 ; Defaults to facility number
10 ; HL7MG - Mail Group (field #4)
11 ; Pointer to entry in MAIL GROUP file (#3.8)
12 ;Output : Ptr^New - Pointer to entry in HL APPLICATION file
13 ; Flag indicating if entry was created
14 ; 1 = Yes
15 ; 0 = No
16 ; -1^Text - Error
17 ;Notes : If an existing entry is found, the currently stored values
18 ; will not be overwritten
19 ; : Default field seperator (#100) and encoding characters (#101)
20 ; are used. This is done by not storing anything in the file
21 ; for these fields.
22 ; : A value for the country code (#7) will not be stored
23 ; : Application will be marked as active
24 ;
25 ;Check input
26 S HL7APP=$G(HL7APP)
27 Q:(HL7APP="") "-1^Did not pass name of HL7 Application to create"
28 Q:((($L(HL7APP)<3))!(($L(HL7APP)>15))) "-1^Did not pass valid name for HL7 Application"
29 S HL7FAC=$G(HL7FAC)
30 S:(HL7FAC="") HL7FAC=+$P($$SITE^VASITE(),"^",3)
31 Q:($L(HL7FAC)>20) "-1^Did not pass valid HL7 Facility Name"
32 S HL7MG=+$G(HL7MG)
33 Q:('$D(^XMB(3.8,HL7MG,0))) "-1^Did not pass valid pointer to Mail Group"
34 ;Declare variables
35 N HL7PTR,DIC,DIE,DA,DR,X,Y,DLAYGO,DTOUT,DUOUT,HL7NEW
36 S DIC="^HL(771,"
37 S DIC(0)="LX"
38 S DIC("DR")="2///ACTIVE;3///^S X=HL7FAC;4////^S X=HL7MG"
39 S DLAYGO=771
40 S X=HL7APP
41 ;Create/find entry
42 D ^DIC
43 S HL7PTR=+Y
44 S HL7NEW=+$P(Y,"^",3)
45 ;Error
46 Q:(HL7PTR<0) "-1^Unable to create HL7 Application"
47 ;Success - done
48 Q HL7PTR_"^"_HL7NEW
49 ;
50OPCMG(RETNAME) ;Get pointer to Mail Group that receives OPC generation bulletin
51 ;Input : RETNAME - Flag indicating if name of Mail Group should
52 ; be returned instead of a pointer to the Mail Group
53 ; 0 = No (default)
54 ; 1 = Yes
55 ;Output : Value contained in OPC GENERATE MAIL GROUP field (#216)
56 ; of the MAS PARAMTER file (#43) - Pointer to MAIL GROUP
57 ; file (#3.8)
58 ;
59 ;Check input
60 S RETNAME=+$G(RETNAME)
61 ;Declare variables
62 N NODE,PTR,NAME
63 ;Get node value is stored on
64 S NODE=$G(^DG(43,1,"SCLR"))
65 ;Get pointer
66 S PTR=+$P(NODE,"^",16)
67 ;Return pointer to Mail Group file
68 Q:('RETNAME) PTR
69 ;Get name of Mail Group
70 S NODE=$G(^XMB(3.8,PTR,0))
71 S NAME=$P(NODE,"^",1)
72 ;Return name of Mail Group
73 Q NAME
Note: See TracBrowser for help on using the repository browser.