- RGMTHLDB ;BIR/CML-MPI/PD HL7 ACTIVITY BY PATIENT/SINGLE PROTOCOL ;11/05/01
- ;;1.0;CLINICAL INFO RESOURCE NETWORK;**21**;30 Apr 99
- ;
- ;Reference to ^ORD(101 supported by IA #2596
- ;Reference to ^HL(772 supported by IA #3464
- ;Reference to ^DPT(DFN,"MPI" supported by IA #2070
- ;
- S QFLG=1
- CHK ;
- I '$D(^XTMP("RGMT","HL")) D G QUIT
- .W !!,$C(7),"The option ""Compile MPI/PD HL7 Data"" must have"
- .W !,"run to completion before this report can be printed!"
- ;
- I '$D(^XTMP("RGMT","HL","@@@@","STOPPED")) D G QUIT
- .W !!,$C(7),"The option ""Compile MPI/PD HL7 Data"" is currently running."
- .W !,"This report cannot be generated until the compile has run to completion."
- .W !!,"Please try again later.",!
- ;
- W @IOF
- I $D(^XTMP("RGMT","HL","@@@@","RANGE")) D
- .W !!,"Data has been compiled for ",^XTMP("RGMT","HL","@@@@","RANGE"),"."
- .W !,"Use the ""Compile MPI/PD HL7 Data"" option if this range is not sufficient."
- ;
- BEGIN ;
- W !!,"This option allows you to search for activity related to a specific protocol in"
- W !,"the HL7 MESSAGE TEXT (#772) file for a patient during a selected period of time."
- W !,"This search is accomplished using data set into a temporary global built by the"
- W !,"option ""Compile MPI/PD HL7 Data""."
- ;
- ASK1 ;Ask for Protocol
- W !
- S DIC="^ORD(101,",DIC(0)="QEAM"
- S DIC("S")="S ORD=$P(^(0),""^"") I $D(^XTMP(""RGMT"",""HL"",ORD))"
- D ^DIC K DIC G:Y<0 QUIT S PROT=$P(Y,"^",2)
- ;
- ASK2 ;Ask for Date Range
- W !
- K DIR,DIRUT,DTOUT,DUOUT
- S DIR(0)="DAO^:DT:EPX",DIR("A")="Beginning Date: "
- D ^DIR K DIR G:$D(DIRUT) QUIT
- ;
- S RGBDT=Y,DIR(0)="DAO^"_RGBDT_":DT:EPX",DIR("A")="Ending Date: "
- D ^DIR K DIR G:$D(DIRUT) QUIT S RGEDT=Y
- ;
- ASK3 ;Ask for TYPE
- W !
- S DIR(0)="SB^I:INCOMING;O:OUTGOING",DIR("A")="Select TYPE"
- D ^DIR K DIR G:$D(DIRUT) QUIT S TYPE=Y
- ;
- ASK4 ;Ask for PATIENT
- W !!!,"Patient lookup can be done by (P)atient Name/SSN or by (I)CN.",!
- S DIR(0)="SB^I:ICN;P:PATIENT NAME/SSN",DIR("A")="Select LOOKUP",DIR("B")="P"
- D ^DIR K DIR G:$D(DIRUT) QUIT S LOOKUP=Y
- I LOOKUP="P" D LOOKUP1 G:'$D(DFN) ASK4
- I LOOKUP="I" D LOOKUP2 G:'$D(DFN) ASK4
- ;
- DEV ;
- W !!,"The right margin for this print is 80.",!!
- S ZTSAVE("RGBDT")="",ZTSAVE("RGEDT")="",ZTSAVE("PROT")=""
- S ZTSAVE("TYPE")="",ZTSAVE("DFN")="",ZTSAVE("ICN")=""
- D EN^XUTMDEVQ("START^RGMTHLDB","MPI/PD - Print HL7 Message Data for Patient/Single Protocol") I 'POP Q
- W !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
- G QUIT
- START ;
- G:'$D(^XTMP("RGMT","HL")) QUIT
- S (PG,QFLG,GOTDATA)=0,U="^",$P(LN,"-",81)="",SITE=$P($$SITE^VASITE(),U,2)
- S PRGBDT=$$FMTE^XLFDT(RGBDT),PRGEDT=$$FMTE^XLFDT(RGEDT)
- D NOW^%DTC S HDT=$$FMTE^XLFDT($E(%,1,12))
- D HDR
- ;
- LOOP ;Loop on ^XTMP("RGMT","HLICN" & ^XTMP("RGMT","HLDFN"
- I '$D(^XTMP("RGMT","HLICN"))&'($D(^XTMP("RGMT","HLDFN"))) G QUIT
- S STOPDT=RGEDT_".9"
- F SUB1="HLICN","HLDFN" S SUB2=$S(SUB1="HLICN":ICN,1:DFN) Q:QFLG D
- .S RGDT=RGBDT-.1
- .F S RGDT=$O(^XTMP("RGMT",SUB1,SUB2,RGDT)) Q:'RGDT Q:RGDT>STOPDT Q:QFLG D
- ..S STAT="" F S STAT=$O(^XTMP("RGMT",SUB1,SUB2,RGDT,PROT,TYPE,STAT)) Q:STAT="" Q:QFLG D
- ...S IEN=0 F S IEN=$O(^XTMP("RGMT",SUB1,SUB2,RGDT,PROT,TYPE,STAT,IEN)) Q:'IEN Q:QFLG D
- ....I ^XTMP("RGMT",SUB1,SUB2,RGDT,PROT,TYPE,STAT,IEN)]"" D BATCHPRT Q
- ....I $O(^HL(772,IEN,"IN",0)) S GOT=0 D Q:QFLG
- .....S TXT=0 F S TXT=$O(^HL(772,IEN,"IN",TXT)) Q:'TXT Q:QFLG D Q:GOT Q:QFLG
- ......I $P(^HL(772,IEN,"IN",TXT,0),U)="PID",+$P(^(0),U,3)=ICN D PROC Q
- ......I $P(^HL(772,IEN,"IN",TXT,0),U)="MFE",$P(^(0),U,2)="MAD",+$P($P(^(0),U,5),"~",4)=ICN D PROC Q
- ......I $P(^HL(772,IEN,"IN",TXT,0),U)="MFE",$P(^(0),U,2)="MUP",+$P(^(0),U,5)=ICN D PROC Q
- ......I $P(^HL(772,IEN,"IN",TXT,0),U)="QAK",+$P(^(0),U,2)=DFN D PROC
- I 'GOTDATA W !,"No data found for this patient."
- ;
- QUIT ;
- I $E(IOST)="C"&('QFLG) S DIR(0)="E" D D ^DIR K DIR
- .S SS=22-$Y F JJ=1:1:SS W !
- K %,BATCHIEN,CNT,DFN,GOT,GOTDATA,HDT,ICN,IEN,JJ,LIM,LINE,LN,LOOKUP,NODE,NUM,PG,PRGBDT
- K PRGEDT,PROT,QFLG,RGBDT,RGDT,RGEDT,SITE,SS,STAT,STOPDT,SUB1,SUB2,TXT,TYPE,Y,ZTSK
- W:$E(IOST)'="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
- ;
- HDR ;HEADER
- I $E(IOST)="C" S SS=22-$Y F JJ=1:1:SS W !
- I $E(IOST)="C",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
- S PG=PG+1 W:$Y!($E(IOST)="C") @IOF I $E(IOST)'="C"!($E(IOST)="C"&(PG=1)) D
- .W !,"HL7 TRANSMISSION DATA at ",SITE," on ",HDT,?72,"Page: ",PG
- .W !!,"Patient: ",$P(^DPT(DFN,0),U)
- .W !,"Protocol: ",PROT
- .W !,"Date Range: ",PRGBDT," to ",PRGEDT,?45,"Type: ",$S(TYPE="I":"INCOMING",1:"OUTGOING"),!
- W !,"File #772 IEN",?19,"Date",?39,"Status",!?4,"""IN"" Subfield",!,LN
- Q
- ;
- BATCHPRT ;
- S GOTDATA=1
- D:$Y+4>IOSL HDR Q:QFLG
- S BATCHIEN=+$P(^XTMP("RGMT",SUB1,SUB2,RGDT,PROT,TYPE,STAT,IEN),",""IN"",",2)
- W !,"Batch Msg #",IEN," - Line #",BATCHIEN
- W !?19,$$FMTE^XLFDT($E(RGDT,1,12)),?39,STAT,!
- S NODE=^HL(772,IEN,"IN",BATCHIEN,0)
- I $L(NODE)>75 D BREAK Q
- W !?4,NODE
- Q
- ;
- PROC ;Print data
- S GOT=1,GOTDATA=1
- W !,IEN,?19,$$FMTE^XLFDT($E(RGDT,1,12)),?39,STAT,!
- S NUM=0 F S NUM=$O(^HL(772,IEN,"IN",NUM)) Q:'NUM Q:QFLG S NODE=^HL(772,IEN,"IN",NUM,0) D
- .I $L(NODE)>75 D BREAK Q
- .D:$Y+3>IOSL HDR Q:QFLG W !?4,NODE
- Q
- ;
- BREAK ;Break up text lines greater than 75
- S CNT=1,LIM=$L(NODE)/75 I LIM["." S LIM=$P(LIM,".")+1
- F LINE=1:1:LIM D:$Y+3>IOSL HDR Q:QFLG W !?4,$E(NODE,CNT,CNT+74) S CNT=CNT+75
- Q
- ;
- LOOKUP1 ;Lookup by patient name/ssn
- W ! K DFN,ICN
- S DIC="^DPT(",DIC(0)="QEAM",DIC("A")="Select PATIENT: " D ^DIC K DIC
- Q:Y<0
- S DFN=+Y
- S ICN=+$P($G(^DPT(DFN,"MPI")),U) I 'ICN W !!,"This patient does not have an ICN!" K DFN,ICN
- Q
- ;
- LOOKUP2 ;Lookup by ICN
- W ! K DFN,ICN
- S DIR(0)="N:1:999999999999:0",DIR("A")="Select ICN" D ^DIR K DIR Q:$D(DIRUT)
- S ICN=Y S DFN=$$GETDFN^MPIF001(ICN)
- I +DFN<0 W !!,"No patient match can be found for this ICN!" K DFN,ICN Q
- W " ",$P(^DPT(DFN,0),"^")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGMTHLDB 5914 printed Mar 13, 2025@20:47:01 Page 2
- RGMTHLDB ;BIR/CML-MPI/PD HL7 ACTIVITY BY PATIENT/SINGLE PROTOCOL ;11/05/01
- +1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**21**;30 Apr 99
- +2 ;
- +3 ;Reference to ^ORD(101 supported by IA #2596
- +4 ;Reference to ^HL(772 supported by IA #3464
- +5 ;Reference to ^DPT(DFN,"MPI" supported by IA #2070
- +6 ;
- +7 SET QFLG=1
- CHK ;
- +1 IF '$DATA(^XTMP("RGMT","HL"))
- Begin DoDot:1
- +2 WRITE !!,$CHAR(7),"The option ""Compile MPI/PD HL7 Data"" must have"
- +3 WRITE !,"run to completion before this report can be printed!"
- End DoDot:1
- GOTO QUIT
- +4 ;
- +5 IF '$DATA(^XTMP("RGMT","HL","@@@@","STOPPED"))
- Begin DoDot:1
- +6 WRITE !!,$CHAR(7),"The option ""Compile MPI/PD HL7 Data"" is currently running."
- +7 WRITE !,"This report cannot be generated until the compile has run to completion."
- +8 WRITE !!,"Please try again later.",!
- End DoDot:1
- GOTO QUIT
- +9 ;
- +10 WRITE @IOF
- +11 IF $DATA(^XTMP("RGMT","HL","@@@@","RANGE"))
- Begin DoDot:1
- +12 WRITE !!,"Data has been compiled for ",^XTMP("RGMT","HL","@@@@","RANGE"),"."
- +13 WRITE !,"Use the ""Compile MPI/PD HL7 Data"" option if this range is not sufficient."
- End DoDot:1
- +14 ;
- BEGIN ;
- +1 WRITE !!,"This option allows you to search for activity related to a specific protocol in"
- +2 WRITE !,"the HL7 MESSAGE TEXT (#772) file for a patient during a selected period of time."
- +3 WRITE !,"This search is accomplished using data set into a temporary global built by the"
- +4 WRITE !,"option ""Compile MPI/PD HL7 Data""."
- +5 ;
- ASK1 ;Ask for Protocol
- +1 WRITE !
- +2 SET DIC="^ORD(101,"
- SET DIC(0)="QEAM"
- +3 SET DIC("S")="S ORD=$P(^(0),""^"") I $D(^XTMP(""RGMT"",""HL"",ORD))"
- +4 DO ^DIC
- KILL DIC
- if Y<0
- GOTO QUIT
- SET PROT=$PIECE(Y,"^",2)
- +5 ;
- ASK2 ;Ask for Date Range
- +1 WRITE !
- +2 KILL DIR,DIRUT,DTOUT,DUOUT
- +3 SET DIR(0)="DAO^:DT:EPX"
- SET DIR("A")="Beginning Date: "
- +4 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- GOTO QUIT
- +5 ;
- +6 SET RGBDT=Y
- SET DIR(0)="DAO^"_RGBDT_":DT:EPX"
- SET DIR("A")="Ending Date: "
- +7 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- GOTO QUIT
- SET RGEDT=Y
- +8 ;
- ASK3 ;Ask for TYPE
- +1 WRITE !
- +2 SET DIR(0)="SB^I:INCOMING;O:OUTGOING"
- SET DIR("A")="Select TYPE"
- +3 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- GOTO QUIT
- SET TYPE=Y
- +4 ;
- ASK4 ;Ask for PATIENT
- +1 WRITE !!!,"Patient lookup can be done by (P)atient Name/SSN or by (I)CN.",!
- +2 SET DIR(0)="SB^I:ICN;P:PATIENT NAME/SSN"
- SET DIR("A")="Select LOOKUP"
- SET DIR("B")="P"
- +3 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- GOTO QUIT
- SET LOOKUP=Y
- +4 IF LOOKUP="P"
- DO LOOKUP1
- if '$DATA(DFN)
- GOTO ASK4
- +5 IF LOOKUP="I"
- DO LOOKUP2
- if '$DATA(DFN)
- GOTO ASK4
- +6 ;
- DEV ;
- +1 WRITE !!,"The right margin for this print is 80.",!!
- +2 SET ZTSAVE("RGBDT")=""
- SET ZTSAVE("RGEDT")=""
- SET ZTSAVE("PROT")=""
- +3 SET ZTSAVE("TYPE")=""
- SET ZTSAVE("DFN")=""
- SET ZTSAVE("ICN")=""
- +4 DO EN^XUTMDEVQ("START^RGMTHLDB","MPI/PD - Print HL7 Message Data for Patient/Single Protocol")
- IF 'POP
- QUIT
- +5 WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
- +6 GOTO QUIT
- START ;
- +1 if '$DATA(^XTMP("RGMT","HL"))
- GOTO QUIT
- +2 SET (PG,QFLG,GOTDATA)=0
- SET U="^"
- SET $PIECE(LN,"-",81)=""
- SET SITE=$PIECE($$SITE^VASITE(),U,2)
- +3 SET PRGBDT=$$FMTE^XLFDT(RGBDT)
- SET PRGEDT=$$FMTE^XLFDT(RGEDT)
- +4 DO NOW^%DTC
- SET HDT=$$FMTE^XLFDT($EXTRACT(%,1,12))
- +5 DO HDR
- +6 ;
- LOOP ;Loop on ^XTMP("RGMT","HLICN" & ^XTMP("RGMT","HLDFN"
- +1 IF '$DATA(^XTMP("RGMT","HLICN"))&'($DATA(^XTMP("RGMT","HLDFN")))
- GOTO QUIT
- +2 SET STOPDT=RGEDT_".9"
- +3 FOR SUB1="HLICN","HLDFN"
- SET SUB2=$SELECT(SUB1="HLICN":ICN,1:DFN)
- if QFLG
- QUIT
- Begin DoDot:1
- +4 SET RGDT=RGBDT-.1
- +5 FOR
- SET RGDT=$ORDER(^XTMP("RGMT",SUB1,SUB2,RGDT))
- if 'RGDT
- QUIT
- if RGDT>STOPDT
- QUIT
- if QFLG
- QUIT
- Begin DoDot:2
- +6 SET STAT=""
- FOR
- SET STAT=$ORDER(^XTMP("RGMT",SUB1,SUB2,RGDT,PROT,TYPE,STAT))
- if STAT=""
- QUIT
- if QFLG
- QUIT
- Begin DoDot:3
- +7 SET IEN=0
- FOR
- SET IEN=$ORDER(^XTMP("RGMT",SUB1,SUB2,RGDT,PROT,TYPE,STAT,IEN))
- if 'IEN
- QUIT
- if QFLG
- QUIT
- Begin DoDot:4
- +8 IF ^XTMP("RGMT",SUB1,SUB2,RGDT,PROT,TYPE,STAT,IEN)]""
- DO BATCHPRT
- QUIT
- +9 IF $ORDER(^HL(772,IEN,"IN",0))
- SET GOT=0
- Begin DoDot:5
- +10 SET TXT=0
- FOR
- SET TXT=$ORDER(^HL(772,IEN,"IN",TXT))
- if 'TXT
- QUIT
- if QFLG
- QUIT
- Begin DoDot:6
- +11 IF $PIECE(^HL(772,IEN,"IN",TXT,0),U)="PID"
- IF +$PIECE(^(0),U,3)=ICN
- DO PROC
- QUIT
- +12 IF $PIECE(^HL(772,IEN,"IN",TXT,0),U)="MFE"
- IF $PIECE(^(0),U,2)="MAD"
- IF +$PIECE($PIECE(^(0),U,5),"~",4)=ICN
- DO PROC
- QUIT
- +13 IF $PIECE(^HL(772,IEN,"IN",TXT,0),U)="MFE"
- IF $PIECE(^(0),U,2)="MUP"
- IF +$PIECE(^(0),U,5)=ICN
- DO PROC
- QUIT
- +14 IF $PIECE(^HL(772,IEN,"IN",TXT,0),U)="QAK"
- IF +$PIECE(^(0),U,2)=DFN
- DO PROC
- End DoDot:6
- if GOT
- QUIT
- if QFLG
- QUIT
- End DoDot:5
- if QFLG
- QUIT
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 IF 'GOTDATA
- WRITE !,"No data found for this patient."
- +16 ;
- QUIT ;
- +1 IF $EXTRACT(IOST)="C"&('QFLG)
- SET DIR(0)="E"
- Begin DoDot:1
- +2 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- End DoDot:1
- DO ^DIR
- KILL DIR
- +3 KILL %,BATCHIEN,CNT,DFN,GOT,GOTDATA,HDT,ICN,IEN,JJ,LIM,LINE,LN,LOOKUP,NODE,NUM,PG,PRGBDT
- +4 KILL PRGEDT,PROT,QFLG,RGBDT,RGDT,RGEDT,SITE,SS,STAT,STOPDT,SUB1,SUB2,TXT,TYPE,Y,ZTSK
- +5 if $EXTRACT(IOST)'="C"
- WRITE @IOF
- DO ^%ZISC
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +6 ;
- HDR ;HEADER
- +1 IF $EXTRACT(IOST)="C"
- SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +2 IF $EXTRACT(IOST)="C"
- IF PG>0
- SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- IF 'Y
- SET QFLG=1
- QUIT
- +3 SET PG=PG+1
- if $Y!($EXTRACT(IOST)="C")
- WRITE @IOF
- IF $EXTRACT(IOST)'="C"!($EXTRACT(IOST)="C"&(PG=1))
- Begin DoDot:1
- +4 WRITE !,"HL7 TRANSMISSION DATA at ",SITE," on ",HDT,?72,"Page: ",PG
- +5 WRITE !!,"Patient: ",$PIECE(^DPT(DFN,0),U)
- +6 WRITE !,"Protocol: ",PROT
- +7 WRITE !,"Date Range: ",PRGBDT," to ",PRGEDT,?45,"Type: ",$SELECT(TYPE="I":"INCOMING",1:"OUTGOING"),!
- End DoDot:1
- +8 WRITE !,"File #772 IEN",?19,"Date",?39,"Status",!?4,"""IN"" Subfield",!,LN
- +9 QUIT
- +10 ;
- BATCHPRT ;
- +1 SET GOTDATA=1
- +2 if $Y+4>IOSL
- DO HDR
- if QFLG
- QUIT
- +3 SET BATCHIEN=+$PIECE(^XTMP("RGMT",SUB1,SUB2,RGDT,PROT,TYPE,STAT,IEN),",""IN"",",2)
- +4 WRITE !,"Batch Msg #",IEN," - Line #",BATCHIEN
- +5 WRITE !?19,$$FMTE^XLFDT($EXTRACT(RGDT,1,12)),?39,STAT,!
- +6 SET NODE=^HL(772,IEN,"IN",BATCHIEN,0)
- +7 IF $LENGTH(NODE)>75
- DO BREAK
- QUIT
- +8 WRITE !?4,NODE
- +9 QUIT
- +10 ;
- PROC ;Print data
- +1 SET GOT=1
- SET GOTDATA=1
- +2 WRITE !,IEN,?19,$$FMTE^XLFDT($EXTRACT(RGDT,1,12)),?39,STAT,!
- +3 SET NUM=0
- FOR
- SET NUM=$ORDER(^HL(772,IEN,"IN",NUM))
- if 'NUM
- QUIT
- if QFLG
- QUIT
- SET NODE=^HL(772,IEN,"IN",NUM,0)
- Begin DoDot:1
- +4 IF $LENGTH(NODE)>75
- DO BREAK
- QUIT
- +5 if $Y+3>IOSL
- DO HDR
- if QFLG
- QUIT
- WRITE !?4,NODE
- End DoDot:1
- +6 QUIT
- +7 ;
- BREAK ;Break up text lines greater than 75
- +1 SET CNT=1
- SET LIM=$LENGTH(NODE)/75
- IF LIM["."
- SET LIM=$PIECE(LIM,".")+1
- +2 FOR LINE=1:1:LIM
- if $Y+3>IOSL
- DO HDR
- if QFLG
- QUIT
- WRITE !?4,$EXTRACT(NODE,CNT,CNT+74)
- SET CNT=CNT+75
- +3 QUIT
- +4 ;
- LOOKUP1 ;Lookup by patient name/ssn
- +1 WRITE !
- KILL DFN,ICN
- +2 SET DIC="^DPT("
- SET DIC(0)="QEAM"
- SET DIC("A")="Select PATIENT: "
- DO ^DIC
- KILL DIC
- +3 if Y<0
- QUIT
- +4 SET DFN=+Y
- +5 SET ICN=+$PIECE($GET(^DPT(DFN,"MPI")),U)
- IF 'ICN
- WRITE !!,"This patient does not have an ICN!"
- KILL DFN,ICN
- +6 QUIT
- +7 ;
- LOOKUP2 ;Lookup by ICN
- +1 WRITE !
- KILL DFN,ICN
- +2 SET DIR(0)="N:1:999999999999:0"
- SET DIR("A")="Select ICN"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- QUIT
- +3 SET ICN=Y
- SET DFN=$$GETDFN^MPIF001(ICN)
- +4 IF +DFN<0
- WRITE !!,"No patient match can be found for this ICN!"
- KILL DFN,ICN
- QUIT
- +5 WRITE " ",$PIECE(^DPT(DFN,0),"^")
- +6 QUIT
