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