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

SCMSP0.m

Go to the documentation of this file. 
  1. SCMSP0 ;ALB/JRP - CHECK POINTS TO CREATE ENTRIES IN HL7 FILES;29-MAY-1996
  1.  ;;5.3;Scheduling;**44,1015**;AUG 13, 1993;Build 21
  1.  ;
  1. HL7EVNT ;Create HL7 event Z00 - HL7 EVENT TYPE CODE file (#779.001)
  1.  ;
  1.  ;Input  : None
  1.  ;Output : None
  1.  ;Note   : This is a KIDS complient check point
  1.  ;
  1.  ;Declare variables
  1.  N DIC,X,Y,DLAYGO,DTOUT,DUOUT,NEWENTRY,MSGTXT,PTREVNT,DIE,DA,DR
  1.  ;Create/find entry
  1.  D BMES^XPDUTL(">>> Creating entry for Z00 in HL7 EVENT TYPE CODE file (#779.001)")
  1.  S DIC="^HL(779.001,"
  1.  S DIC(0)="L"
  1.  S DIC("DR")="2///Ambulatory Care transmission to/from NPCDB"
  1.  S DLAYGO=779.001
  1.  S X="Z00"
  1.  D ^DIC
  1.  S PTREVNT=+Y
  1.  S NEWENTRY=+$P(Y,"^",3)
  1.  S MSGTXT(1)="    Existing entry found - support of HL7 v2.2 will be added/verified"
  1.  S:(NEWENTRY) MSGTXT(1)="    Entry created - support of HL7 v2.2 will be added"
  1.  I (PTREVNT<0) D
  1.  .S MSGTXT(1)="    ** Unable to create entry for Z00"
  1.  .S MSGTXT(2)="    ** Entry must be created manually"
  1.  D MES^XPDUTL(.MSGTXT)
  1.  K MSGTXT
  1.  ;Don't continue if entry wasn't created
  1.  Q:(PTREVNT<0)
  1.  ;Add support for HL7 version 2.2
  1.  S DIC="^HL(779.001,"_PTREVNT_",1,"
  1.  S DIC(0)="LX"
  1.  S DIC("P")=$P(^DD(779.001,100,0),"^",2)
  1.  S DA(1)=PTREVNT
  1.  S DLAYGO=779.001
  1.  S X="2.2"
  1.  D ^DIC
  1.  S MSGTXT(1)="    Support for HL7 v2.2 "_$S($P(Y,"^",3):"added",1:"verified")
  1.  I (Y<0) D
  1.  .S MSGTXT(1)="    ** Unable to add support for HL7 v2.2"
  1.  .S MSGTXT(2)="    ** Support for HL7 v2.2 must be added manually"
  1.  D MES^XPDUTL(.MSGTXT)
  1.  ;Done
  1.  Q
  1.  ;
  1. HL7APPS ;Create required entries in HL APPLICATION file (#771)
  1.  ;
  1.  ;Input  : None
  1.  ;Output : None
  1.  ;Note   : This is a KIDS complient check point
  1.  ;
  1.  ;Declare variables
  1.  N APPNAME,FACNUM,MAILGRP,MSGTXT,PTRAPP
  1.  D BMES^XPDUTL(">>> Creating entries in HL APPLICATION file (#771)")
  1.  ;Create sending application
  1.  S APPNAME="AMBCARE-DHCP"
  1.  S FACNUM=+$P($$SITE^VASITE(),"^",3)
  1.  S MAILGRP=$$OPCMG^SCMSPU1(0)
  1.  I ('MAILGRP) D  Q
  1.  .S MSGTXT(1)="    ** MAS PARAMETER file (#43) does not have a value for"
  1.  .S MSGTXT(2)="       the OPC GENERATE MAIL GROUP field (#216)"
  1.  .S MSGTXT(3)="    ** Entries for AMBCARE-DHCP and NPCD-AAC in the HL"
  1.  .S MSGTXT(4)="       APPLICATION file (#771) can not be created"
  1.  .S MSGTXT(5)="    ** Entries must be manually entered"
  1.  .D MES^XPDUTL(.MSGTXT)
  1.  D MES^XPDUTL("     Creating entry for sending application (AMBCARE-DHCP)")
  1.  S PTRAPP=$$CRTAPP^SCMSPU1(APPNAME,FACNUM,MAILGRP)
  1.  S MSGTXT(1)="       Entry for AMBCARE-DHCP successfully created"
  1.  I ('$P(PTRAPP,"^",2)) D
  1.  .S MSGTXT(1)="      Existing entry for AMBCARE-DHCP found - current values not overwritten"
  1.  I (PTRAPP<0) D
  1.  .S MSGTXT(1)="       ** Unable to create entry for AMBCARE-DHCP"
  1.  .S MSGTXT(2)="       ** "_$P(PTRAPP,"^",2)
  1.  .S MSGTXT(3)="       ** Sending application must be added manually"
  1.  D MES^XPDUTL(.MSGTXT)
  1.  K MSGTXT
  1.  ;Create receiving application
  1.  S APPNAME="NPCD-AAC"
  1.  S FACNUM=200
  1.  S MAILGRP=$$OPCMG^SCMSPU1(0)
  1.  D MES^XPDUTL("     Creating entry for receiving application (NPCD-AAC)")
  1.  S PTRAPP=$$CRTAPP^SCMSPU1(APPNAME,FACNUM,MAILGRP)
  1.  S MSGTXT(1)="       Entry for NPCD-AAC successfully created"
  1.  I ('$P(PTRAPP,"^",2)) D
  1.  .S MSGTXT(1)="      Existing entry for NPCD-AAC found - current values not overwritten"
  1.  I (PTRAPP<0) D
  1.  .S MSGTXT(1)="       ** Unable to create entry for NPCD-AAC"
  1.  .S MSGTXT(2)="       ** "_$P(PTRAPP,"^",2)
  1.  .S MSGTXT(3)="       ** Receiving application must be added manually"
  1.  D MES^XPDUTL(.MSGTXT)
  1.  ;Done
  1.  Q
  1.  ;
  1. MAILGRP ;Create entry in MAIL GROUP file (#3.8) that will be attached to
  1.  ; the lower level protocol parameter
  1.  ;
  1.  ;Input  : None
  1.  ;Output : None
  1.  ;Note   : This is a KIDS complient check point
  1.  ;
  1.  ;Declare variables
  1.  N NAME,DESC,PTR2MG,MSGTXT,DIE,DIC,DA,DR,X,Y,DTOUT
  1.  D BMES^XPDUTL(">>> Creating entry in MAIL GROUP file (#3.8)")
  1.  ;Create entry in MAIL GROUP file
  1.  S NAME="SCDX AMBCARE TO NPCDB"
  1.  S DESC(1)="Mail Group used by the Ambulatory Care Reporting Project to"
  1.  S DESC(2)="transmit data to the National Patient Care Database via HL7"
  1.  S PTR2MG=$$MG^XMBGRP(NAME,0,.5,0,.XMY,.DESC,1)
  1.  S MSGTXT(1)="    Entry for SCDX AMBCARE TO NPCDB successfully created"
  1.  I ('PTR2MG) D
  1.  .S MSGTXT(1)="    ** Unable to create entry for SCDX AMBCARE TO NPCDB"
  1.  .S MSGTXT(2)="    ** Entry must be created manually"
  1.  D MES^XPDUTL(.MSGTXT)
  1.  K MSGTXT
  1.  ;Don't continue if entry wasn't created
  1.  Q:('PTR2MG)
  1.  ;Add queue for National Patient Care Database as REMOTE MEMBER
  1.  D MES^XPDUTL("    Adding National Patient Care Database (NPCDB) to Mail Group")
  1.  S DIC="^XMB(3.8,"_PTR2MG_",6,"
  1.  S DIC(0)="LX"
  1.  S DIC("P")=$P(^DD(3.8,12,0),"^",2)
  1.  S DA(1)=PTR2MG
  1.  S DLAYGO=3.8
  1.  S X="XXX@Q-ACS.MED.VA.GOV"
  1.  D ^DIC
  1.  S MSGTXT(1)="    XXX@Q-ACS.MED.VA.GOV successfully added as REMOTE MEMBER"
  1.  I (Y<0) D
  1.  .S MSGTXT(1)="    ** Unable to add XXX@Q-ACS.MED.VA.GOV as REMOTE MEMBER"
  1.  .S MSGTXT(2)="    ** Remote member must be added manually"
  1.  D MES^XPDUTL(.MSGTXT)
  1.  ;Done
  1.  Q
  1.  ;
  1. HL7LLPP ;Create entry in HL LOWER LEVEL PROTOCOL PARAMETER file (#869.2)
  1.  ;
  1.  ;Input  : None
  1.  ;Output : None
  1.  ;Note   : This is a KIDS complient check point
  1.  ;       : If an entry for AMB-CARE already exists, values currently
  1.  ;         defined for the entry will not be overwritten
  1.  ;
  1.  ;Declare variables
  1.  N DIC,X,Y,DLAYGO,DTOUT,DUOUT,NEWENTRY,PTRLLPP,DIE,DA,DR,MSGTXT
  1.  ;Create entry
  1.  D BMES^XPDUTL(">>> Creating entry in HL LOWER LEVEL PROTOCOL PARAMETER file (#869.2)")
  1.  S DIC="^HLCS(869.2,"
  1.  S DIC(0)="LX"
  1.  S DIC("DR")=".02///MAILMAN;100.01///SCDX AMBCARE TO NPCDB"
  1.  S DLAYGO=869.2
  1.  S X="AMB-CARE"
  1.  D ^DIC
  1.  S PTRLLPP=+Y
  1.  S NEWENTRY=+$P(Y,"^",3)
  1.  S MSGTXT(1)="    Entry for AMB-CARE created"
  1.  I ((PTRLLPP)&('NEWENTRY)) D
  1.  .S MSGTXT(1)="    Entry for AMB-CARE found"
  1.  .S MSGTXT(2)="    Existing information will not be overwritten"
  1.  I (PTRLLPP<0) D
  1.  .S MSGTXT(1)="    ** Unable to create entry for AMB-CARE"
  1.  .S MSGTXT(2)="    ** Entry must be created manually"
  1.  D MES^XPDUTL(.MSGTXT)
  1.  ;Done
  1.  Q
  1.  ;
  1.  ;
  1.  ;Input  : None
  1.  ;Output : None
  1.  ;Note   : This is a KIDS complient check point
  1.  ;       : If an entry for AMB-CARE already exists, values currently
  1.  ;         defined for the entry will not be overwritten
  1.  ;
  1.  ;Declare variables
  1.  N DIC,X,Y,DLAYGO,DTOUT,DUOUT,NEWENTRY,PTRLINK,DIE,DA,DR,MSGTXT
  1.  ;Create entry
  1.  D BMES^XPDUTL(">>> Creating entry in HL LOGICAL LINK file (#870)")
  1.  S DIC="^HLCS(870,"
  1.  S DIC(0)="LX"
  1.  S DIC("DR")="2///AMB-CARE"
  1.  S DLAYGO=870
  1.  S X="AMB-CARE"
  1.  D ^DIC
  1.  S PTRLINK=+Y
  1.  S NEWENTRY=+$P(Y,"^",3)
  1.  S MSGTXT(1)="    Entry for AMB-CARE created"
  1.  I ((PTRLINK)&('NEWENTRY)) D
  1.  .S MSGTXT(1)="    Entry for AMB-CARE found"
  1.  .S MSGTXT(2)="    Existing information will not be overwritten"
  1.  I (PTRLINK<0) D
  1.  .S MSGTXT(1)="    ** Unable to create entry for AMB-CARE"
  1.  .S MSGTXT(2)="    ** Entry must be created manually"
  1.  D MES^XPDUTL(.MSGTXT)
  1.  ;Done
  1.  Q