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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMSPU1 2766 printed Apr 09, 2024@21:55:19 Page 2
SCMSPU1 ;ALB/JRP - AMB CARE POST INIT UTILITIES;03-JUN-1996
+1 ;;5.3;Scheduling;**44**;AUG 13, 1993
CRTAPP(HL7APP,HL7FAC,HL7MG) ;Create/find entry in HL APPLICATION file (#771)
+1 ;
+2 ;Input : HL7APP - Name of application to create (field #.01)
+3 ; Free text - 3 to 15 characters
+4 ; HL7FAC - Facility name (field #3)
+5 ; Free text - 1 to 20 characters
+6 ; Defaults to facility number
+7 ; HL7MG - Mail Group (field #4)
+8 ; Pointer to entry in MAIL GROUP file (#3.8)
+9 ;Output : Ptr^New - Pointer to entry in HL APPLICATION file
+10 ; Flag indicating if entry was created
+11 ; 1 = Yes
+12 ; 0 = No
+13 ; -1^Text - Error
+14 ;Notes : If an existing entry is found, the currently stored values
+15 ; will not be overwritten
+16 ; : Default field seperator (#100) and encoding characters (#101)
+17 ; are used. This is done by not storing anything in the file
+18 ; for these fields.
+19 ; : A value for the country code (#7) will not be stored
+20 ; : Application will be marked as active
+21 ;
+22 ;Check input
+23 SET HL7APP=$GET(HL7APP)
+24 if (HL7APP="")
QUIT "-1^Did not pass name of HL7 Application to create"
+25 if ((($LENGTH(HL7APP)<3))!(($LENGTH(HL7APP)>15)))
QUIT "-1^Did not pass valid name for HL7 Application"
+26 SET HL7FAC=$GET(HL7FAC)
+27 if (HL7FAC="")
SET HL7FAC=+$PIECE($$SITE^VASITE(),"^",3)
+28 if ($LENGTH(HL7FAC)>20)
QUIT "-1^Did not pass valid HL7 Facility Name"
+29 SET HL7MG=+$GET(HL7MG)
+30 if ('$DATA(^XMB(3.8,HL7MG,0)))
QUIT "-1^Did not pass valid pointer to Mail Group"
+31 ;Declare variables
+32 NEW HL7PTR,DIC,DIE,DA,DR,X,Y,DLAYGO,DTOUT,DUOUT,HL7NEW
+33 SET DIC="^HL(771,"
+34 SET DIC(0)="LX"
+35 SET DIC("DR")="2///ACTIVE;3///^S X=HL7FAC;4////^S X=HL7MG"
+36 SET DLAYGO=771
+37 SET X=HL7APP
+38 ;Create/find entry
+39 DO ^DIC
+40 SET HL7PTR=+Y
+41 SET HL7NEW=+$PIECE(Y,"^",3)
+42 ;Error
+43 if (HL7PTR<0)
QUIT "-1^Unable to create HL7 Application"
+44 ;Success - done
+45 QUIT HL7PTR_"^"_HL7NEW
+46 ;
OPCMG(RETNAME) ;Get pointer to Mail Group that receives OPC generation bulletin
+1 ;Input : RETNAME - Flag indicating if name of Mail Group should
+2 ; be returned instead of a pointer to the Mail Group
+3 ; 0 = No (default)
+4 ; 1 = Yes
+5 ;Output : Value contained in OPC GENERATE MAIL GROUP field (#216)
+6 ; of the MAS PARAMTER file (#43) - Pointer to MAIL GROUP
+7 ; file (#3.8)
+8 ;
+9 ;Check input
+10 SET RETNAME=+$GET(RETNAME)
+11 ;Declare variables
+12 NEW NODE,PTR,NAME
+13 ;Get node value is stored on
+14 SET NODE=$GET(^DG(43,1,"SCLR"))
+15 ;Get pointer
+16 SET PTR=+$PIECE(NODE,"^",16)
+17 ;Return pointer to Mail Group file
+18 if ('RETNAME)
QUIT PTR
+19 ;Get name of Mail Group
+20 SET NODE=$GET(^XMB(3.8,PTR,0))
+21 SET NAME=$PIECE(NODE,"^",1)
+22 ;Return name of Mail Group
+23 QUIT NAME
