SCMSP0 ;ALB/JRP - CHECK POINTS TO CREATE ENTRIES IN HL7 FILES;29-MAY-1996
;;5.3;Scheduling;**44**;AUG 13, 1993
;
HL7EVNT ;Create HL7 event Z00 - HL7 EVENT TYPE CODE file (#779.001)
;
;Input : None
;Output : None
;Note : This is a KIDS complient check point
;
;Declare variables
N DIC,X,Y,DLAYGO,DTOUT,DUOUT,NEWENTRY,MSGTXT,PTREVNT,DIE,DA,DR
;Create/find entry
D BMES^XPDUTL(">>> Creating entry for Z00 in HL7 EVENT TYPE CODE file (#779.001)")
S DIC="^HL(779.001,"
S DIC(0)="L"
S DIC("DR")="2///Ambulatory Care transmission to/from NPCDB"
S DLAYGO=779.001
S X="Z00"
D ^DIC
S PTREVNT=+Y
S NEWENTRY=+$P(Y,"^",3)
S MSGTXT(1)=" Existing entry found - support of HL7 v2.2 will be added/verified"
S:(NEWENTRY) MSGTXT(1)=" Entry created - support of HL7 v2.2 will be added"
I (PTREVNT<0) D
.S MSGTXT(1)=" ** Unable to create entry for Z00"
.S MSGTXT(2)=" ** Entry must be created manually"
D MES^XPDUTL(.MSGTXT)
K MSGTXT
;Don't continue if entry wasn't created
Q:(PTREVNT<0)
;Add support for HL7 version 2.2
S DIC="^HL(779.001,"_PTREVNT_",1,"
S DIC(0)="LX"
S DIC("P")=$P(^DD(779.001,100,0),"^",2)
S DA(1)=PTREVNT
S DLAYGO=779.001
S X="2.2"
D ^DIC
S MSGTXT(1)=" Support for HL7 v2.2 "_$S($P(Y,"^",3):"added",1:"verified")
I (Y<0) D
.S MSGTXT(1)=" ** Unable to add support for HL7 v2.2"
.S MSGTXT(2)=" ** Support for HL7 v2.2 must be added manually"
D MES^XPDUTL(.MSGTXT)
;Done
Q
;
HL7APPS ;Create required entries in HL APPLICATION file (#771)
;
;Input : None
;Output : None
;Note : This is a KIDS complient check point
;
;Declare variables
N APPNAME,FACNUM,MAILGRP,MSGTXT,PTRAPP
D BMES^XPDUTL(">>> Creating entries in HL APPLICATION file (#771)")
;Create sending application
S APPNAME="AMBCARE-DHCP"
S FACNUM=+$P($$SITE^VASITE(),"^",3)
S MAILGRP=$$OPCMG^SCMSPU1(0)
I ('MAILGRP) D Q
.S MSGTXT(1)=" ** MAS PARAMETER file (#43) does not have a value for"
.S MSGTXT(2)=" the OPC GENERATE MAIL GROUP field (#216)"
.S MSGTXT(3)=" ** Entries for AMBCARE-DHCP and NPCD-AAC in the HL"
.S MSGTXT(4)=" APPLICATION file (#771) can not be created"
.S MSGTXT(5)=" ** Entries must be manually entered"
.D MES^XPDUTL(.MSGTXT)
D MES^XPDUTL(" Creating entry for sending application (AMBCARE-DHCP)")
S PTRAPP=$$CRTAPP^SCMSPU1(APPNAME,FACNUM,MAILGRP)
S MSGTXT(1)=" Entry for AMBCARE-DHCP successfully created"
I ('$P(PTRAPP,"^",2)) D
.S MSGTXT(1)=" Existing entry for AMBCARE-DHCP found - current values not overwritten"
I (PTRAPP<0) D
.S MSGTXT(1)=" ** Unable to create entry for AMBCARE-DHCP"
.S MSGTXT(2)=" ** "_$P(PTRAPP,"^",2)
.S MSGTXT(3)=" ** Sending application must be added manually"
D MES^XPDUTL(.MSGTXT)
K MSGTXT
;Create receiving application
S APPNAME="NPCD-AAC"
S FACNUM=200
S MAILGRP=$$OPCMG^SCMSPU1(0)
D MES^XPDUTL(" Creating entry for receiving application (NPCD-AAC)")
S PTRAPP=$$CRTAPP^SCMSPU1(APPNAME,FACNUM,MAILGRP)
S MSGTXT(1)=" Entry for NPCD-AAC successfully created"
I ('$P(PTRAPP,"^",2)) D
.S MSGTXT(1)=" Existing entry for NPCD-AAC found - current values not overwritten"
I (PTRAPP<0) D
.S MSGTXT(1)=" ** Unable to create entry for NPCD-AAC"
.S MSGTXT(2)=" ** "_$P(PTRAPP,"^",2)
.S MSGTXT(3)=" ** Receiving application must be added manually"
D MES^XPDUTL(.MSGTXT)
;Done
Q
;
MAILGRP ;Create entry in MAIL GROUP file (#3.8) that will be attached to
; the lower level protocol parameter
;
;Input : None
;Output : None
;Note : This is a KIDS complient check point
;
;Declare variables
N NAME,DESC,PTR2MG,MSGTXT,DIE,DIC,DA,DR,X,Y,DTOUT
D BMES^XPDUTL(">>> Creating entry in MAIL GROUP file (#3.8)")
;Create entry in MAIL GROUP file
S NAME="SCDX AMBCARE TO NPCDB"
S DESC(1)="Mail Group used by the Ambulatory Care Reporting Project to"
S DESC(2)="transmit data to the National Patient Care Database via HL7"
S PTR2MG=$$MG^XMBGRP(NAME,0,.5,0,.XMY,.DESC,1)
S MSGTXT(1)=" Entry for SCDX AMBCARE TO NPCDB successfully created"
I ('PTR2MG) D
.S MSGTXT(1)=" ** Unable to create entry for SCDX AMBCARE TO NPCDB"
.S MSGTXT(2)=" ** Entry must be created manually"
D MES^XPDUTL(.MSGTXT)
K MSGTXT
;Don't continue if entry wasn't created
Q:('PTR2MG)
;Add queue for National Patient Care Database as REMOTE MEMBER
D MES^XPDUTL(" Adding National Patient Care Database (NPCDB) to Mail Group")
S DIC="^XMB(3.8,"_PTR2MG_",6,"
S DIC(0)="LX"
S DIC("P")=$P(^DD(3.8,12,0),"^",2)
S DA(1)=PTR2MG
S DLAYGO=3.8
S X="XXX@Q-ACS.DOMAIN.EXT"
D ^DIC
S MSGTXT(1)=" XXX@Q-ACS.DOMAIN.EXT successfully added as REMOTE MEMBER"
I (Y<0) D
.S MSGTXT(1)=" ** Unable to add XXX@Q-ACS.DOMAIN.EXT as REMOTE MEMBER"
.S MSGTXT(2)=" ** Remote member must be added manually"
D MES^XPDUTL(.MSGTXT)
;Done
Q
;
HL7LLPP ;Create entry in HL LOWER LEVEL PROTOCOL PARAMETER file (#869.2)
;
;Input : None
;Output : None
;Note : This is a KIDS complient check point
; : If an entry for AMB-CARE already exists, values currently
; defined for the entry will not be overwritten
;
;Declare variables
N DIC,X,Y,DLAYGO,DTOUT,DUOUT,NEWENTRY,PTRLLPP,DIE,DA,DR,MSGTXT
;Create entry
D BMES^XPDUTL(">>> Creating entry in HL LOWER LEVEL PROTOCOL PARAMETER file (#869.2)")
S DIC="^HLCS(869.2,"
S DIC(0)="LX"
S DIC("DR")=".02///MAILMAN;100.01///SCDX AMBCARE TO NPCDB"
S DLAYGO=869.2
S X="AMB-CARE"
D ^DIC
S PTRLLPP=+Y
S NEWENTRY=+$P(Y,"^",3)
S MSGTXT(1)=" Entry for AMB-CARE created"
I ((PTRLLPP)&('NEWENTRY)) D
.S MSGTXT(1)=" Entry for AMB-CARE found"
.S MSGTXT(2)=" Existing information will not be overwritten"
I (PTRLLPP<0) D
.S MSGTXT(1)=" ** Unable to create entry for AMB-CARE"
.S MSGTXT(2)=" ** Entry must be created manually"
D MES^XPDUTL(.MSGTXT)
;Done
Q
;
HL7LINK ;Create entry in HL LOGICAL LINK file (#870)
;
;Input : None
;Output : None
;Note : This is a KIDS complient check point
; : If an entry for AMB-CARE already exists, values currently
; defined for the entry will not be overwritten
;
;Declare variables
N DIC,X,Y,DLAYGO,DTOUT,DUOUT,NEWENTRY,PTRLINK,DIE,DA,DR,MSGTXT
;Create entry
D BMES^XPDUTL(">>> Creating entry in HL LOGICAL LINK file (#870)")
S DIC="^HLCS(870,"
S DIC(0)="LX"
S DIC("DR")="2///AMB-CARE"
S DLAYGO=870
S X="AMB-CARE"
D ^DIC
S PTRLINK=+Y
S NEWENTRY=+$P(Y,"^",3)
S MSGTXT(1)=" Entry for AMB-CARE created"
I ((PTRLINK)&('NEWENTRY)) D
.S MSGTXT(1)=" Entry for AMB-CARE found"
.S MSGTXT(2)=" Existing information will not be overwritten"
I (PTRLINK<0) D
.S MSGTXT(1)=" ** Unable to create entry for AMB-CARE"
.S MSGTXT(2)=" ** Entry must be created manually"
D MES^XPDUTL(.MSGTXT)
;Done
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMSP0 6937 printed Apr 09, 2024@22:05:14 Page 2
SCMSP0 ;ALB/JRP - CHECK POINTS TO CREATE ENTRIES IN HL7 FILES;29-MAY-1996
+1 ;;5.3;Scheduling;**44**;AUG 13, 1993
+2 ;
HL7EVNT ;Create HL7 event Z00 - HL7 EVENT TYPE CODE file (#779.001)
+1 ;
+2 ;Input : None
+3 ;Output : None
+4 ;Note : This is a KIDS complient check point
+5 ;
+6 ;Declare variables
+7 NEW DIC,X,Y,DLAYGO,DTOUT,DUOUT,NEWENTRY,MSGTXT,PTREVNT,DIE,DA,DR
+8 ;Create/find entry
+9 DO BMES^XPDUTL(">>> Creating entry for Z00 in HL7 EVENT TYPE CODE file (#779.001)")
+10 SET DIC="^HL(779.001,"
+11 SET DIC(0)="L"
+12 SET DIC("DR")="2///Ambulatory Care transmission to/from NPCDB"
+13 SET DLAYGO=779.001
+14 SET X="Z00"
+15 DO ^DIC
+16 SET PTREVNT=+Y
+17 SET NEWENTRY=+$PIECE(Y,"^",3)
+18 SET MSGTXT(1)=" Existing entry found - support of HL7 v2.2 will be added/verified"
+19 if (NEWENTRY)
SET MSGTXT(1)=" Entry created - support of HL7 v2.2 will be added"
+20 IF (PTREVNT<0)
Begin DoDot:1
+21 SET MSGTXT(1)=" ** Unable to create entry for Z00"
+22 SET MSGTXT(2)=" ** Entry must be created manually"
End DoDot:1
+23 DO MES^XPDUTL(.MSGTXT)
+24 KILL MSGTXT
+25 ;Don't continue if entry wasn't created
+26 if (PTREVNT<0)
QUIT
+27 ;Add support for HL7 version 2.2
+28 SET DIC="^HL(779.001,"_PTREVNT_",1,"
+29 SET DIC(0)="LX"
+30 SET DIC("P")=$PIECE(^DD(779.001,100,0),"^",2)
+31 SET DA(1)=PTREVNT
+32 SET DLAYGO=779.001
+33 SET X="2.2"
+34 DO ^DIC
+35 SET MSGTXT(1)=" Support for HL7 v2.2 "_$SELECT($PIECE(Y,"^",3):"added",1:"verified")
+36 IF (Y<0)
Begin DoDot:1
+37 SET MSGTXT(1)=" ** Unable to add support for HL7 v2.2"
+38 SET MSGTXT(2)=" ** Support for HL7 v2.2 must be added manually"
End DoDot:1
+39 DO MES^XPDUTL(.MSGTXT)
+40 ;Done
+41 QUIT
+42 ;
HL7APPS ;Create required entries in HL APPLICATION file (#771)
+1 ;
+2 ;Input : None
+3 ;Output : None
+4 ;Note : This is a KIDS complient check point
+5 ;
+6 ;Declare variables
+7 NEW APPNAME,FACNUM,MAILGRP,MSGTXT,PTRAPP
+8 DO BMES^XPDUTL(">>> Creating entries in HL APPLICATION file (#771)")
+9 ;Create sending application
+10 SET APPNAME="AMBCARE-DHCP"
+11 SET FACNUM=+$PIECE($$SITE^VASITE(),"^",3)
+12 SET MAILGRP=$$OPCMG^SCMSPU1(0)
+13 IF ('MAILGRP)
Begin DoDot:1
+14 SET MSGTXT(1)=" ** MAS PARAMETER file (#43) does not have a value for"
+15 SET MSGTXT(2)=" the OPC GENERATE MAIL GROUP field (#216)"
+16 SET MSGTXT(3)=" ** Entries for AMBCARE-DHCP and NPCD-AAC in the HL"
+17 SET MSGTXT(4)=" APPLICATION file (#771) can not be created"
+18 SET MSGTXT(5)=" ** Entries must be manually entered"
+19 DO MES^XPDUTL(.MSGTXT)
End DoDot:1
QUIT
+20 DO MES^XPDUTL(" Creating entry for sending application (AMBCARE-DHCP)")
+21 SET PTRAPP=$$CRTAPP^SCMSPU1(APPNAME,FACNUM,MAILGRP)
+22 SET MSGTXT(1)=" Entry for AMBCARE-DHCP successfully created"
+23 IF ('$PIECE(PTRAPP,"^",2))
Begin DoDot:1
+24 SET MSGTXT(1)=" Existing entry for AMBCARE-DHCP found - current values not overwritten"
End DoDot:1
+25 IF (PTRAPP<0)
Begin DoDot:1
+26 SET MSGTXT(1)=" ** Unable to create entry for AMBCARE-DHCP"
+27 SET MSGTXT(2)=" ** "_$PIECE(PTRAPP,"^",2)
+28 SET MSGTXT(3)=" ** Sending application must be added manually"
End DoDot:1
+29 DO MES^XPDUTL(.MSGTXT)
+30 KILL MSGTXT
+31 ;Create receiving application
+32 SET APPNAME="NPCD-AAC"
+33 SET FACNUM=200
+34 SET MAILGRP=$$OPCMG^SCMSPU1(0)
+35 DO MES^XPDUTL(" Creating entry for receiving application (NPCD-AAC)")
+36 SET PTRAPP=$$CRTAPP^SCMSPU1(APPNAME,FACNUM,MAILGRP)
+37 SET MSGTXT(1)=" Entry for NPCD-AAC successfully created"
+38 IF ('$PIECE(PTRAPP,"^",2))
Begin DoDot:1
+39 SET MSGTXT(1)=" Existing entry for NPCD-AAC found - current values not overwritten"
End DoDot:1
+40 IF (PTRAPP<0)
Begin DoDot:1
+41 SET MSGTXT(1)=" ** Unable to create entry for NPCD-AAC"
+42 SET MSGTXT(2)=" ** "_$PIECE(PTRAPP,"^",2)
+43 SET MSGTXT(3)=" ** Receiving application must be added manually"
End DoDot:1
+44 DO MES^XPDUTL(.MSGTXT)
+45 ;Done
+46 QUIT
+47 ;
MAILGRP ;Create entry in MAIL GROUP file (#3.8) that will be attached to
+1 ; the lower level protocol parameter
+2 ;
+3 ;Input : None
+4 ;Output : None
+5 ;Note : This is a KIDS complient check point
+6 ;
+7 ;Declare variables
+8 NEW NAME,DESC,PTR2MG,MSGTXT,DIE,DIC,DA,DR,X,Y,DTOUT
+9 DO BMES^XPDUTL(">>> Creating entry in MAIL GROUP file (#3.8)")
+10 ;Create entry in MAIL GROUP file
+11 SET NAME="SCDX AMBCARE TO NPCDB"
+12 SET DESC(1)="Mail Group used by the Ambulatory Care Reporting Project to"
+13 SET DESC(2)="transmit data to the National Patient Care Database via HL7"
+14 SET PTR2MG=$$MG^XMBGRP(NAME,0,.5,0,.XMY,.DESC,1)
+15 SET MSGTXT(1)=" Entry for SCDX AMBCARE TO NPCDB successfully created"
+16 IF ('PTR2MG)
Begin DoDot:1
+17 SET MSGTXT(1)=" ** Unable to create entry for SCDX AMBCARE TO NPCDB"
+18 SET MSGTXT(2)=" ** Entry must be created manually"
End DoDot:1
+19 DO MES^XPDUTL(.MSGTXT)
+20 KILL MSGTXT
+21 ;Don't continue if entry wasn't created
+22 if ('PTR2MG)
QUIT
+23 ;Add queue for National Patient Care Database as REMOTE MEMBER
+24 DO MES^XPDUTL(" Adding National Patient Care Database (NPCDB) to Mail Group")
+25 SET DIC="^XMB(3.8,"_PTR2MG_",6,"
+26 SET DIC(0)="LX"
+27 SET DIC("P")=$PIECE(^DD(3.8,12,0),"^",2)
+28 SET DA(1)=PTR2MG
+29 SET DLAYGO=3.8
+30 SET X="XXX@Q-ACS.DOMAIN.EXT"
+31 DO ^DIC
+32 SET MSGTXT(1)=" XXX@Q-ACS.DOMAIN.EXT successfully added as REMOTE MEMBER"
+33 IF (Y<0)
Begin DoDot:1
+34 SET MSGTXT(1)=" ** Unable to add XXX@Q-ACS.DOMAIN.EXT as REMOTE MEMBER"
+35 SET MSGTXT(2)=" ** Remote member must be added manually"
End DoDot:1
+36 DO MES^XPDUTL(.MSGTXT)
+37 ;Done
+38 QUIT
+39 ;
HL7LLPP ;Create entry in HL LOWER LEVEL PROTOCOL PARAMETER file (#869.2)
+1 ;
+2 ;Input : None
+3 ;Output : None
+4 ;Note : This is a KIDS complient check point
+5 ; : If an entry for AMB-CARE already exists, values currently
+6 ; defined for the entry will not be overwritten
+7 ;
+8 ;Declare variables
+9 NEW DIC,X,Y,DLAYGO,DTOUT,DUOUT,NEWENTRY,PTRLLPP,DIE,DA,DR,MSGTXT
+10 ;Create entry
+11 DO BMES^XPDUTL(">>> Creating entry in HL LOWER LEVEL PROTOCOL PARAMETER file (#869.2)")
+12 SET DIC="^HLCS(869.2,"
+13 SET DIC(0)="LX"
+14 SET DIC("DR")=".02///MAILMAN;100.01///SCDX AMBCARE TO NPCDB"
+15 SET DLAYGO=869.2
+16 SET X="AMB-CARE"
+17 DO ^DIC
+18 SET PTRLLPP=+Y
+19 SET NEWENTRY=+$PIECE(Y,"^",3)
+20 SET MSGTXT(1)=" Entry for AMB-CARE created"
+21 IF ((PTRLLPP)&('NEWENTRY))
Begin DoDot:1
+22 SET MSGTXT(1)=" Entry for AMB-CARE found"
+23 SET MSGTXT(2)=" Existing information will not be overwritten"
End DoDot:1
+24 IF (PTRLLPP<0)
Begin DoDot:1
+25 SET MSGTXT(1)=" ** Unable to create entry for AMB-CARE"
+26 SET MSGTXT(2)=" ** Entry must be created manually"
End DoDot:1
+27 DO MES^XPDUTL(.MSGTXT)
+28 ;Done
+29 QUIT
+30 ;
HL7LINK ;Create entry in HL LOGICAL LINK file (#870)
+1 ;
+2 ;Input : None
+3 ;Output : None
+4 ;Note : This is a KIDS complient check point
+5 ; : If an entry for AMB-CARE already exists, values currently
+6 ; defined for the entry will not be overwritten
+7 ;
+8 ;Declare variables
+9 NEW DIC,X,Y,DLAYGO,DTOUT,DUOUT,NEWENTRY,PTRLINK,DIE,DA,DR,MSGTXT
+10 ;Create entry
+11 DO BMES^XPDUTL(">>> Creating entry in HL LOGICAL LINK file (#870)")
+12 SET DIC="^HLCS(870,"
+13 SET DIC(0)="LX"
+14 SET DIC("DR")="2///AMB-CARE"
+15 SET DLAYGO=870
+16 SET X="AMB-CARE"
+17 DO ^DIC
+18 SET PTRLINK=+Y
+19 SET NEWENTRY=+$PIECE(Y,"^",3)
+20 SET MSGTXT(1)=" Entry for AMB-CARE created"
+21 IF ((PTRLINK)&('NEWENTRY))
Begin DoDot:1
+22 SET MSGTXT(1)=" Entry for AMB-CARE found"
+23 SET MSGTXT(2)=" Existing information will not be overwritten"
End DoDot:1
+24 IF (PTRLINK<0)
Begin DoDot:1
+25 SET MSGTXT(1)=" ** Unable to create entry for AMB-CARE"
+26 SET MSGTXT(2)=" ** Entry must be created manually"
End DoDot:1
+27 DO MES^XPDUTL(.MSGTXT)
+28 ;Done
+29 QUIT
