74 lines
2.6 KiB
Mathematica
74 lines
2.6 KiB
Mathematica
|
SCMSPU1 ;ALB/JRP - AMB CARE POST INIT UTILITIES;03-JUN-1996
|
||
|
|
;;5.3;Scheduling;**44**;AUG 13, 1993
|
||
|
|
CRTAPP(HL7APP,HL7FAC,HL7MG) ;Create/find entry in HL APPLICATION file (#771)
|
||
|
|
;
|
||
|
|
;Input : HL7APP - Name of application to create (field #.01)
|
||
|
|
; Free text - 3 to 15 characters
|
||
|
|
; HL7FAC - Facility name (field #3)
|
||
|
|
; Free text - 1 to 20 characters
|
||
|
|
; Defaults to facility number
|
||
|
|
; HL7MG - Mail Group (field #4)
|
||
|
|
; Pointer to entry in MAIL GROUP file (#3.8)
|
||
|
|
;Output : Ptr^New - Pointer to entry in HL APPLICATION file
|
||
|
|
; Flag indicating if entry was created
|
||
|
|
; 1 = Yes
|
||
|
|
; 0 = No
|
||
|
|
; -1^Text - Error
|
||
|
|
;Notes : If an existing entry is found, the currently stored values
|
||
|
|
; will not be overwritten
|
||
|
|
; : Default field seperator (#100) and encoding characters (#101)
|
||
|
|
; are used. This is done by not storing anything in the file
|
||
|
|
; for these fields.
|
||
|
|
; : A value for the country code (#7) will not be stored
|
||
|
|
; : Application will be marked as active
|
||
|
|
;
|
||
|
|
;Check input
|
||
|
|
S HL7APP=$G(HL7APP)
|
||
|
|
Q:(HL7APP="") "-1^Did not pass name of HL7 Application to create"
|
||
|
|
Q:((($L(HL7APP)<3))!(($L(HL7APP)>15))) "-1^Did not pass valid name for HL7 Application"
|
||
|
|
S HL7FAC=$G(HL7FAC)
|
||
|
|
S:(HL7FAC="") HL7FAC=+$P($$SITE^VASITE(),"^",3)
|
||
|
|
Q:($L(HL7FAC)>20) "-1^Did not pass valid HL7 Facility Name"
|
||
|
|
S HL7MG=+$G(HL7MG)
|
||
|
|
Q:('$D(^XMB(3.8,HL7MG,0))) "-1^Did not pass valid pointer to Mail Group"
|
||
|
|
;Declare variables
|
||
|
|
N HL7PTR,DIC,DIE,DA,DR,X,Y,DLAYGO,DTOUT,DUOUT,HL7NEW
|
||
|
|
S DIC="^HL(771,"
|
||
|
|
S DIC(0)="LX"
|
||
|
|
S DIC("DR")="2///ACTIVE;3///^S X=HL7FAC;4////^S X=HL7MG"
|
||
|
|
S DLAYGO=771
|
||
|
|
S X=HL7APP
|
||
|
|
;Create/find entry
|
||
|
|
D ^DIC
|
||
|
|
S HL7PTR=+Y
|
||
|
|
S HL7NEW=+$P(Y,"^",3)
|
||
|
|
;Error
|
||
|
|
Q:(HL7PTR<0) "-1^Unable to create HL7 Application"
|
||
|
|
;Success - done
|
||
|
|
Q HL7PTR_"^"_HL7NEW
|
||
|
|
;
|
||
|
|
OPCMG(RETNAME) ;Get pointer to Mail Group that receives OPC generation bulletin
|
||
|
|
;Input : RETNAME - Flag indicating if name of Mail Group should
|
||
|
|
; be returned instead of a pointer to the Mail Group
|
||
|
|
; 0 = No (default)
|
||
|
|
; 1 = Yes
|
||
|
|
;Output : Value contained in OPC GENERATE MAIL GROUP field (#216)
|
||
|
|
; of the MAS PARAMTER file (#43) - Pointer to MAIL GROUP
|
||
|
|
; file (#3.8)
|
||
|
|
;
|
||
|
|
;Check input
|
||
|
|
S RETNAME=+$G(RETNAME)
|
||
|
|
;Declare variables
|
||
|
|
N NODE,PTR,NAME
|
||
|
|
;Get node value is stored on
|
||
|
|
S NODE=$G(^DG(43,1,"SCLR"))
|
||
|
|
;Get pointer
|
||
|
|
S PTR=+$P(NODE,"^",16)
|
||
|
|
;Return pointer to Mail Group file
|
||
|
|
Q:('RETNAME) PTR
|
||
|
|
;Get name of Mail Group
|
||
|
|
S NODE=$G(^XMB(3.8,PTR,0))
|
||
|
|
S NAME=$P(NODE,"^",1)
|
||
|
|
;Return name of Mail Group
|
||
|
|
Q NAME
|