SCMSPU1.m

SCMSPU1 ;ALB/JRP - AMB CARE POST INIT UTILITIES;03-JUN-1996

 ;;5.3;Scheduling;**44,1015**;AUG 13, 1993;Build 21

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

SCMSPU1   ;ALB/JRP - AMB CARE POST INIT UTILITIES;03-JUN-1996

 +1       ;;5.3;Scheduling;**44,1015**;AUG 13, 1993;Build 21

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