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

HLERCHK.m

Go to the documentation of this file.
  1. HLERCHK ;SFCIOFO/JC - Interface Debugger ;02/25/2004 14:25
  1. ;;1.6;HEALTH LEVEL SEVEN;**57,96,108**;Oct 13, 1995
  1. ;This routine requires the following to work:
  1. ;EVENT DRIVER PROTOCOL TYPE
  1. ;It will report inconsistencies with the event driver, susbscribers,
  1. ;applications and logical links (if defined)
  1. W !,"This routine searches for HL7 protocols with possible errors."
  1. S DIR(0)="FAOU"
  1. S DIR("A")="Select an EVENT DRIVER Protocol: "
  1. S DIR("B")="All"
  1. S DIR("?")="^D DICQ^HLERCHK"
  1. D ^DIR
  1. K DIC,DA,DR I Y="All" S HLANS=0 G ASKDEV
  1. S X=Y S DIC="^ORD(101,",DIC(0)="EMQZ"
  1. S DIC("S")="I $P(^(0),U,4)=""E"""
  1. D ^DIC
  1. Q:$D(DTOUT)!($D(DUOUT))
  1. Q:+Y=-1
  1. S HLANS=+Y
  1. ASKDEV ;
  1. S %ZIS="MQ"
  1. D ^%ZIS
  1. G:POP EXIT
  1. I $D(IO("Q")) D G EXIT
  1. .S ZTDESC="HL7 Interface Debugger",ZTRTN="EN^HLERCHK",ZTSAVE("*")=""
  1. .S ZTDTH=$H D ^%ZTLOAD
  1. .D HOME^%ZIS
  1. .W !,$S($D(ZTSK):"Queued to task number: "_ZTSK,1:"NOT QUEUED")
  1. EN ;
  1. U IO
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. W !," ** HL7 INTERFACE DEBUGGER **"
  1. S HL57=0 I $D(^ORD(101,"AHL21")) S HL57=1
  1. ;patch HL*1.6*96 start: add application ack for HL7 v2.4, and others.
  1. S HLACK="ACK,ADR,ARD,EDR,ERP,MCF,MFK,MFR,ORF,ORG,ORR,OSR,RAR,RCI,RCL,"
  1. S HLACK=HLACK_"RDR,RDY,RER,RGR,ROR,RRA,RRD,RRE,RRG,RRI,RSP,RTB,SQR,"
  1. S HLACK=HLACK_"TBR,VXR,VXX"
  1. ;patch HL*1.6*96 end
  1. ;patch HL*1.6*108 start: add application ack for HL7 v2.5.
  1. S HLACK=HLACK_",BRP,BRT,ORB,ORI"
  1. ;patch HL*1.6*108 end
  1. I 'HLANS S HLPIEN=0 F S HLPIEN=$O(^ORD(101,HLPIEN)) Q:HLPIEN<1 D
  1. .Q:$P(^ORD(101,HLPIEN,0),U,4)'="E"
  1. .D CHKED(HLPIEN)
  1. I +HLANS D CHKED(+HLANS)
  1. D EXIT
  1. Q
  1. DICQ ;
  1. N X,Y,DIC
  1. S X="??"
  1. S DIC="^ORD(101,",DIC(0)="EQ"
  1. S DIC("S")="I $P(^(0),U,4)=""E"""
  1. D ^DIC
  1. Q
  1. CHKED(PP) ;Check Event Driver Protocols
  1. K ERR,HLPN,HL770,HLVSP,HLVSN,HLSAPP,HLSAPN,HLMTPP,HLMTPN,HLETPP,HLETPN S ERR=0
  1. S HLPN=$P($G(^ORD(101,PP,0)),U)
  1. I HLPN="" S ERR=ERR+1,ERR(ERR)="Protocol is UNDEFINED." Q
  1. I $P(^ORD(101,PP,0),U,3)]"" S ERR=ERR+1,ERR(ERR)="**PROTOCOL DISABLED**" Q
  1. S HL770=$G(^ORD(101,PP,770))
  1. I HL770="" S ERR=ERR+1,ERR(ERR)="Missing data for all key fields." Q
  1. VSN ;Version
  1. S HLVSP=$P(HL770,U,10)
  1. I HLVSP<1 S ERR=ERR+1,ERR(ERR)="Version ID is required."
  1. S HLVSN="" I HLVSP S HLVSN=$P($G(^HL(771.5,HLVSP,0)),U)
  1. APP ;Sending App
  1. S HLSAPP=$P(HL770,U),HLSAPN=""
  1. I 'HLSAPP S ERR=ERR+1,ERR(ERR)="Missing Required Sending Application."
  1. I HLSAPP S HLSAPN=$P($G(^HL(771,HLSAPP,0)),U)
  1. I HLSAPP,HLSAPN="" S ERR=ERR+1,ERR(ERR)="Broken pointer to App Param (file 771)."
  1. I HLSAPP D CHKAPP(HLSAPP)
  1. MT ;Message Type
  1. S HLMTPP=$P(HL770,U,3),HLMTPN=""
  1. I 'HLMTPP S ERR=ERR+1,ERR(ERR)="Missing required Message Type."
  1. I HLMTPP S HLMTPN=$P($G(^HL(771.2,HLMTPP,0)),U)
  1. I HLMTPP,HLMTPN="" S ERR=ERR+1,ERR(ERR)="Broken pointer to Msg Type (file 771.2)."
  1. I HLMTPN]"",HLACK[HLMTPN S ERR=ERR+1,ERR(ERR)="For Event Driver-Message Type cannot be an acknowledgement."
  1. ET ;Event Type
  1. S HLETPP=$P(HL770,U,4),HLETPN=""
  1. S HLETPN="" I HLETPP S HLETPN=$P($G(^HL(779.001,HLETPP,0)),U)
  1. I HLETPN="" S ERR=ERR+1,ERR(ERR)="Broken pointer to Event Type (file 779.001)."
  1. I 'HLETPP,$G(HLVSN)>2.1 S ERR=ERR+1,ERR(ERR)="Event type is required for versions greater than 2.1."
  1. OUT1 S $P(LINE,"_",75)=""
  1. W !,LINE
  1. W !,"Event Driver: ",HLPN
  1. W !!,"Sending Application: ",HLSAPN
  1. W !,"Version: ",$G(HLVSN)," ","Message Type(770.3): ",$G(HLMTPN)," ","Event Type: ",$G(HLETPN)
  1. W !!,"Event Driver Error Summary:",!
  1. I $G(ERR)<1 W !,"No Event Driver Errors Found."
  1. I $G(ERR) S N=0 F S N=$O(ERR(N)) Q:N<1 W !,N,". ",ERR(N)
  1. SUB ;Check Subscribers
  1. S HL770=$G(^ORD(101,PP,770))
  1. I HL770="" S ERR=ERR+1,ERR(ERR)="Missing data for all key fields." Q
  1. S HLNODE="^ORD(101,PP,10)"
  1. I HL57 S HLNODE="^ORD(101,PP,775)"
  1. I '$D(@HLNODE) W !,"No Subscribers Found."
  1. S HLX=0 F S HLX=$O(@HLNODE@(HLX)) Q:HLX<1 S HLSUBP=$P(@HLNODE@(HLX,0),U) D CHKSUB(HLSUBP)
  1. Q
  1. CHKSUB(PP) ;Scan Subscribers
  1. K ERR,HLPN,HL770,HLVSP,HLVSN,HLRAPP,HLRAPN,HLMTPP,HLMTPN,HLETPP,HLETPN S ERR=0
  1. S HLPN=$P($G(^ORD(101,PP,0)),U)
  1. I HLPN="" S ERR=ERR+1,ERR(ERR)="Subscriber Protocol is UNDEFINED." Q
  1. I $P(^ORD(101,PP,0),U,3)]"" S ERR=ERR+1,ERR(ERR)="**SUBSCRIBER PROTOCOL DISABLED**" Q
  1. S HL770=$G(^ORD(101,PP,770))
  1. I HL770="" S ERR=ERR+1,ERR(ERR)="Missing data for all key fields." Q
  1. S HLRAPP=$P(HL770,U,2),HLRAPN=""
  1. I 'HLRAPP S ERR=ERR+1,ERR(ERR)="Missing Required Receiving Application."
  1. I HLRAPP S HLRAPN=$P($G(^HL(771,HLRAPP,0)),U)
  1. I HLRAPP,HLRAPN="" S ERR=ERR+1,ERR(ERR)="Broken pointer to App Param (file 771)."
  1. I HLRAPP D CHKAPP(HLRAPP)
  1. S HLMTPN="",HLMTPP=$P(HL770,U,11) I HLMTPP D ;Response Message Type
  1. .I HLMTPP S HLMTPN=$P($G(^HL(771.2,HLMTPP,0)),U)
  1. .I HLMTPP,HLMTPN="" S ERR=ERR+1,ERR(ERR)="Broken pointer to Msg Type (file 771.2)."
  1. .I HLMTPN]"",HLACK'[HLMTPN S ERR=ERR+1,ERR(ERR)="Message Type must be an appropriate response/acknowledgement."
  1. S HLETPP=$P(HL770,U,4),HLETPN=""
  1. I HLETPP S HLETPN=$P($G(^HL(779.001,HLETPP,0)),U)
  1. I HLETPP,HLETPN="" S ERR=ERR+1,ERR(ERR)="Broken pointer to Event Type (file 779.001)."
  1. I $G(^ORD(101,PP,774))=""&($G(^ORD(101,PP,771)))="" S ERR=ERR+1,ERR(ERR)="Missing Processing Routine and Routing Logic."
  1. I $G(^ORD(101,PP,774))=""&($P(HL770,U,7))="" S ERR=ERR+1,ERR(ERR)="WARNING-Missing both Logical Link and Routing Logic. Will be local only."
  1. OUT2 ;Print Subscriber Errors
  1. S $P(STAR,"*",40)=""
  1. W !,?10,STAR
  1. W !,?10,"For Subscriber: ",$G(HLPN)
  1. W !!,?10,"Receiving Application: ",$G(HLRAPN)
  1. W !,?10,"Message Type (770.11): ",$G(HLMTPN)," ","Event Type: ",$G(HLETPN),!
  1. I 'ERR W !,?10,"No Subscriber Errors Found."
  1. F ERR=1:1:ERR W !,?10,ERR,". ",ERR(ERR)
  1. Q
  1. CHKAPP(APP) ;Check Application parameters
  1. Q:'$D(^HL(771,APP))
  1. I $P(^HL(771,APP,0),U,2)="I" S ERR=ERR+1,ERR(ERR)="Application is INACTIVE."
  1. Q
  1. EXIT ;
  1. K ZTSK,HL57,HL770,HLACK,HLETPN,HLETPP,HLMTPN,HLMTPP,HLNODE,HLPIEN,HLPN,HLRAPP,HLSAPN,HLSAPP,HLSUBP,HLVSN,HLVSP,HLX,LINE,STAR,SAPP,ERR
  1. Q