- 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 Jan 18, 2025@03:43:07 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