Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCMSPU1

SCMSPU1.m

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