| 1 | SCMSPU1 ;ALB/JRP - AMB CARE POST INIT UTILITIES;03-JUN-1996
|
|---|
| 2 | ;;5.3;Scheduling;**44**;AUG 13, 1993
|
|---|
| 3 | CRTAPP(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 | ;
|
|---|
| 50 | OPCMG(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
|
|---|
