AGMPHLU1 ; IHS/SD/TPF - MPI HLO UTILITIES ; 12/15/2007
;;7.2;IHS PATIENT REGISTRATION;**1,6**;JAN 07, 2011;Build 23
Q
;
;OIT PROGRAMMER USE ONLY - NO OPTION
LOADTST(EVENT,START,LASTCNT) ;EP - TEST MPI LOAD
; 9/18/2017 - GCD - CR 7705 - Disabled this because it should never be run in the field.
Q
;
N IEN,COUNT,CNT
S COUNT=0
S IEN=$G(START)
S:IEN="" IEN=0
F CNT=1:1 S IEN=$O(^DPT(IEN)) Q:'IEN!(COUNT>LASTCNT) D
.Q:$P($G(^DPT(IEN,"MPI")),U)'="" ;DURING TESTING DON'T SEND IF ALREADY SENT
.Q:$D(^DPT(IEN,-9))
.Q:'$O(^AUPNPAT(IEN,41,0))
.I $$DEMOPAT^AGMPHLU($G(IEN)) Q ; 9/13/2017 - GCD - CR 7713 - Don't upload demo patients.
.S COUNT=COUNT+1
.I '(CNT#100) W "."
.D NOW^%DTC S NOW=%
.I EVENT="A01" D CREATE^AGMPHL01(4,IEN,NOW) Q
.I EVENT="A03" D CREATE^AGMPHL03(1,IEN,"T"_NOW) Q
.D CREATMSG^AGMPIHLO(IEN,EVENT)
W !,"TOTAL "_EVENT_" MESSAGES SENT: ",COUNT
Q
;
FINDERR ;EP - SEACH FOR ERR IN ^HLA
FROMERR ;EP
K DIR
S DIR(0)="DO^::E"
S DIR("A")="Enter from Date"
S DIR("B")="T"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y="")
S FROMERR=Y
TOERR ;EP
K DIR
S DIR(0)="DO^::E"
S DIR("A")="Enter to Date"
S DIR("B")="T"
D ^DIR
G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y="") FROMERR
S TOERR=Y_".999999"
I FROMERR>TOERR D G FROMERR
.W !!,"FROM DATE CAN NOT BE GREATER THAN TO DATE!!" H 2
S FROMERR=FROMERR-.00001
SHOW ;EP
K DIR
S DIR(0)="YO"
S DIR("A")="Display originating message"
S DIR("B")="N"
D ^DIR
G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y="") TOERR
S SHOW=Y
W !!,"FINDING ERR SEGMENTS IN HLA"
N COUNT,MSG,DASH
S COUNT=0
D DOCOUNT(.COUNT)
W !!,"THERE WERE "_COUNT_" ERR ERRORS FOUND"
I COUNT=0 D Q
.K DIR
.S DIR(0)="E"
.D ^DIR
S %ZIS="MQ"
W !
D ^%ZIS
Q:POP
I $D(IO("Q")) D QUEERR Q
U IO
QUEPRINT ;EP ENTER FROM TASKMAN
S $P(DASH,"-",81)=""
N CODECNT
S TOTCOUNT=0
S ESC=0
S PAGE=1
D NOW^%DTC S Y=% X ^DD("DD") S PRTDATE=Y
D HDRERR
S MSGDATE=FROMERR-.0001
F S MSGDATE=$O(^HLA("B",MSGDATE)) Q:MSGDATE=""!(ESC) D
.Q:+MSGDATE>TOERR!(+MSGDATE<FROMERR)
.S MSGIEN=""
.F S MSGIEN=$O(^HLA("B",MSGDATE,MSGIEN)) Q:MSGIEN=""!(ESC) D
..S LINK=$P($G(^HLB(MSGIEN,0)),U,5)
..Q:LINK'="MPI"
..;W !,MSGDATE
..Q:$P($G(^HLA(MSGIEN,1,3,0)),U)'="ERR"
..S ENTRYDT=$P($G(^HLA(MSGIEN,0)),U)
..S ACKCODE=$P($G(^HLA(MSGIEN,1,1,0)),U,2)
..S MSGID=$P($G(^HLA(MSGIEN,1,1,0)),U,3)
..S OMSGIEN=$P(MSGID," ",2)
..S LOCALID=$P($P($G(^HLA(OMSGIEN,1,3,0)),"|",3),"~")
..S TOTCOUNT=TOTCOUNT+1
..I $Y>(IOSL-4),(IO=IO(0)),'$D(IO("S")) K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ESC=$G(X)=U Q:ESC D HDRERR
..I $Y>(IOSL-4),$D(ZTQUEUED) D HDRERR
..W !!,DASH
..W !,"PATIENT DFN: ",LOCALID
..W !,"HLA IEN: ",MSGIEN
..W !,"MSG ID: ",MSGID
..W !,"ORIGINATING MSG IEN: ",OMSGIEN
..W !,"ACK CODE: ",ACKCODE
..W !,$G(^HLA(MSGIEN,1,3,0))
..S CODECNT(ACKCODE)=$G(CODECNT(ACKCODE))+1
..I SHOW D LISTOMSG(OMSGIEN)
D PRTERRCD(.CODECNT)
W !!!,"TOTAL ERRORS: ",TOTCOUNT
I '$D(ZTQUEUED) D
.U 0
.W !
.K DIR
.S DIR(0)="E"
.D ^DIR
D ^%ZISC
Q
;
HDRERR ;EP - HEADER
W @IOF
W !,$$C^XBFUNC("MSG ERR REPORT",IOM)
W ?70,"PAGE ",PAGE
S PAGE=PAGE+1
W !,$$CJ^XLFSTR("DATE PRINTED: "_PRTDATE,IOM)
W !,$$CJ^XLFSTR("PRINTED BY: "_$P($G(^VA(200,DUZ,0)),U),IOM)
W !,DASH,!!
Q
;
PRTERRCD(CODECNT) ;EP
N ACKCODE
S ACKCODE=""
F S ACKCODE=$O(CODECNT(ACKCODE)) Q:ACKCODE="" D
.W !,"TOTAL "_ACKCODE_" ERRS: ",CODECNT(ACKCODE)
Q
;
QUEERR ; EP - QUE AE ERROR REPORT
S ZTRTN="QUEPRINT^AGMPHLU1"
S ZTDESC="HLO AE ERROR MESSAGE REPORT"
S ZTSAVE("FROMERR")=""
S ZTSAVE("TOERR")=""
S ZTSAVE("SHOW")=""
D ^%ZTLOAD
I $D(ZTSK)[0 W !!?5,"Report Cancelled!"
E W !!?5,"Report task #: ",$G(ZTSK)
D HOME^%ZIS
Q
;
DOCOUNT(COUNT) ;EP - GET COUNT OF ERR MSGS
S MSGIEN=0 F S MSGIEN=$O(^HLA(MSGIEN)) Q:'MSGIEN D
.S ENTRYDT=$P($G(^HLA(MSGIEN,0)),U)
.Q:ENTRYDT>TOERR!(ENTRYDT<FROMERR)
.Q:$P($G(^HLA(MSGIEN,1,3,0)),U)'="ERR"
.S COUNT=COUNT+1
Q
;
LISTOMSG(OMSGIEN) ;EP - LIST ORIGINATING MESSAGE
N DATA
W !!,"ORINATING MESSAGE:"
S REC=0
F S REC=$O(^HLA(OMSGIEN,1,REC)) Q:'REC D
.S DATA=$G(^HLA(OMSGIEN,1,REC,0))
.Q:DATA=""
.W !,DATA
Q
;
FINDSEG(SEG,SHOW) ;EP - FIND SEG SEGMENT IN MESSAGE
;YOU CAN USE THIS FOR ANY EN MASSE CHANGES
;OIT PROGRAMMER USE ONLY - NO OPTION
N IEN,REC,MSGTYPE,FOUND
S FOUND=0
I SEG="MSH" S GLOREF="^HLB"
E S GLOREF="^HLA"
S IEN=0
F S IEN=$O(@GLOREF@(IEN)) Q:'IEN D
.I SEG'="MSH" D
..S REC=0
..F S REC=$O(@GLOREF@(IEN,1,REC)) Q:'REC D
...Q:$P($G(@GLOREF@(IEN,1,REC,0)),U)'=SEG
...;PLACE ANY EDITS NEEDED HERE
...W !,@GLOREF@(IEN,1,REC,0)
...S TEMP=$P(@GLOREF@(IEN,1,REC,0),U,45)
...S DATE=$P(TEMP," ")
...S TIME=$P(TEMP," ",2)
...W !,"DATE: ",DATE
...W !,"TIME: ",TIME
...S FOUND=FOUND+1
...S FOUND(IEN)=""
.E D ;EDITS TO MSH HEADER
..Q:$P($G(@GLOREF@(IEN,0)),U,4)'="O" ;ONLY OUTGOING
..;PLACE ANY EDITS NEEDED HERE
..W !!!,"IEN: ",IEN
..W !,$G(@GLOREF@(IEN,1))
..W !,$P($G(@GLOREF@(IEN,1)),U,6)
..;S TEMP=$P($G(@GLOREF@(IEN,1)),U,6)
..;I $P(TEMP,"~")="8990" Q
..;S $P(TEMP,"~")="8990"
..;B "S+"
..;S $P(@GLOREF@(IEN,1),U,6)=TEMP
..S FOUND=FOUND+1
..S FOUND(IEN)=""
W !,"FOUND "_FOUND_" "_SEG_" IN MESSAGE"
;ZW FOUND
Q
;
ASKEVN ;EP - ASK EVENT
N EVENT,MSGTYPE,ACKCODE,ONLYCNT
K DIR
S DIR(0)="SO^A28:ADD A PATIENT;A08:UPDATE A PATIENT;A40:MERGE PATIENTS"
S DIR(0)=DIR(0)_";A01:ADMIT/CHECKIN A PATIENT;A03:DISCHARGE/CHECK OUT A PATIENT"
S DIR(0)=DIR(0)_";M05:TREATING FACILITY UPDATE" ;OR MFN?
S DIR("A")="ENTER EVENT"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT)!(Y="")
S EVENT=Y
ASKTYPE ;EP - ASK MSG TYPE
K DIR
S DIR(0)="SO^ADT:ADMIT DISCHARGE TRANSFER;ACK:ACKNOWLEDGEMENTS;MFN:TREATING FACILITY UPDATE"
S DIR("A")="ENTER MSG TYPE"
D ^DIR
G:$D(DTOUT)!$D(DUOUT)!(Y="") ASKEVN
S MSGTYPE=Y
;B "S+"
S ACKCODE=""
I MSGTYPE="ACK" D Q:$D(DTOUT)!$D(DUOUT)!(Y="")
.K DIR
.S DIR(0)="SO^AA:APPLICATION ACCEPT;AE:APPLICATION ERROR;AR:APPLICATION REJECT"
.S DIR(0)=DIR(0)_";CA:COMMIT ACCEPT;CE:COMMIT ERROR;CR:COMMIT REJECT" ;OR MFN?
.S DIR("A")="ENTER ACK CODE"
.D ^DIR
.S ACKCODE=Y
ASKCNT ;EP - ASK IF ONLY A COUNT IS NEEDED
K DIR
S DIR(0)="YO"
S DIR("A")="TOTALS ONLY"
D ^DIR
G:$D(DTOUT)!$D(DUOUT)!(Y="") ASKTYPE
S ONLYCNT=Y=1
S %ZIS="MQ"
W !
D ^%ZIS
Q:POP
I $D(IO("Q")) D QUEEVN Q
U IO
FINDEVN ;EP - FIND EVENT
;FINDEVN("A28","ACK","CA")
N IEN,REC,FOUND,DASH
S $P(DASH,"-",81)=""
D NOW^%DTC S Y=% X ^DD("DD") S PRTDATE=Y
S PAGE=1
D HDREVN
S ESC=0
S FOUND=0
S IEN=0
F S IEN=$O(^HLA(IEN)) Q:'IEN!ESC D
.I EVENT'="" Q:$P($G(^HLA(IEN,0)),U,4)'=EVENT
.I MSGTYPE'="" Q:$P($G(^HLA(IEN,0)),U,3)'=MSGTYPE
.Q:$G(^HLA(IEN,1,1,0))'[ACKCODE
.I $Y>(IOSL-4),(IO=IO(0)),'$D(IO("S")) K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ESC=$G(X)=U Q:ESC D HDREVN
.I $Y>(IOSL-4),$D(ZTQUEUED) D HDREVN
.I 'ONLYCNT D
..W !!,IEN_" *** "_$G(^HLA(IEN,0))
..D LISTOMSG(IEN)
.S FOUND=FOUND+1
W !,"FOUND "_FOUND_" '"_EVENT_"' EVENTS IN ^HLA WITH MSGTPYE '"_MSGTYPE
I $G(ACKCODE)'="" W "' AND ACKCODE '"_ACKCODE_"'"
D ^%ZISC
I '$D(ZTQUEUED) D
.U 0
.W !
.K DIR
.S DIR(0)="E"
.D ^DIR
Q
;
QUEEVN ;EP -
S ZTRTN="FINDEVN^AGMPHLU1"
S ZTDESC="MPI FIND EVENT/TYPE/ACK REPORT"
S ZTSAVE("EVENT")="",ZTSAVE("MSGTYPE")="",ZTSAVE("ACKCODE")=""
D ^%ZTLOAD
I $D(ZTSK)[0 W !!?5,"Report Cancelled!"
E W !!?5,"Report task #: ",$G(ZTSK)
D HOME^%ZIS
Q
;
HDREVN ;EP -
W @IOF
W !,$$C^XBFUNC("MPI FIND EVENT/TYPE/ACK REPORT",IOM)
W ?70,"PAGE ",PAGE
W !,$$CJ^XLFSTR("DATE PRINTED: "_PRTDATE,IOM)
W !,$$CJ^XLFSTR("PRINTED BY: "_$P($G(^VA(200,DUZ,0)),U),IOM)
W !,DASH,!!
S PAGE=PAGE+1
Q
;
RPTBYDT ;EP - REPORT OF MSG TYPE AND EVENT BY DATE RANGE
N MSGTYPE,EVENT,FROM,TO,MSGDATE,REC,MSGTYPCT,EVENTCNT,TOTMSG,TYPEEVNT,DASH,ESC
ASKFROM ;EP
K DIR
S DIR(0)="DO^::E"
S DIR("A")="Enter from Date"
S DIR("B")="T"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y="")
S FROM=Y
ASKTO ;EP
K DIR
S DIR(0)="DO^::E"
S DIR("A")="Enter to Date"
S DIR("B")="T"
D ^DIR
G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y="") ASKFROM
S TO=Y_".999999"
I FROM>TO D G ASKFROM
.W !!,"FROM DATE CAN NOT BE GREATER THAN TO DATE!!" H 2
REPEAT ;EP -
S TYPEEVNT="" F S TYPEEVNT=$O(TYPEEVNT(TYPEEVNT)) Q:TYPEEVNT="" S TYPEEVNT(TYPEEVNT)=0
S ESC=0
S TOTMSG=0
S MSGDATE=FROM-.01
F S MSGDATE=$O(^HLA("B",MSGDATE)) Q:MSGDATE=""!(ESC) D
.Q:+MSGDATE>TO!(+MSGDATE<FROM)
.S REC=""
.F S REC=$O(^HLA("B",MSGDATE,REC)) Q:REC="" D
..S LINK=$P($G(^HLB(REC,0)),U,5)
..Q:LINK'="MPI"
..S MSGTYPE=$P($G(^HLA(REC,0)),U,3)
..S EVENT=$P($G(^HLA(REC,0)),U,4)
..S TYPEEVNT=EVENT_U_MSGTYPE
..S TYPEEVNT(TYPEEVNT)=$G(TYPEEVNT(TYPEEVNT))+1
..S TOTMSG=TOTMSG+1
D NOW^%DTC S Y=% X ^DD("DD") S PRTDATE=Y
S PAGE=1
S ESC=0
S $P(DASH,"-",81)=""
D BYDTHDR
S FIRST=""
S TYPEEVNT=""
F CNT=1:1 S TYPEEVNT=$O(TYPEEVNT(TYPEEVNT)) Q:TYPEEVNT=""!ESC D
.I CNT'=1,(FIRST'=$P(TYPEEVNT,U)) W !!
.S FIRST=$P(TYPEEVNT,U)
.W !,TYPEEVNT,?12,$J(TYPEEVNT(TYPEEVNT),10)
.W ?25,$J($FN(TYPEEVNT(TYPEEVNT)/TOTMSG*100,",",2),10)
W !,"---------------------------------------"
W !!,"TOTAL MSGS: ",$J(TOTMSG,10)
I '$D(ZTQUEUED) D S ESC=X=U Q:ESC
.U 0
.W !
.K DIR
.S DIR(0)="E"
.D ^DIR
I '$D(ZTQUEUED) G REPEAT
Q
;
BYDTHDR ;EP - RPTBYDT HEADER
W @IOF
W !,$$C^XBFUNC("MESSAGE REPORT BY DATE",IOM)
W ?70,"PAGE ",PAGE
W !,$$CJ^XLFSTR("DATE PRINTED: "_PRTDATE,IOM)
W !,$$CJ^XLFSTR("PRINTED BY: "_$P($G(^VA(200,DUZ,0)),U),IOM)
W !,$$CJ^XLFSTR("AT FACILITY: "_$P($G(^DIC(4,DUZ(2),0)),U),IOM)
S Y=FROM X ^DD("DD") S EXFROM=Y
S Y=TO X ^DD("DD") S EXTO=Y
W !,$$CJ^XLFSTR("FOR MESSAGES FROM "_EXFROM_" TO "_EXTO,IOM)
W !,DASH,!!
W !!,"EVENT^TYPE",?16,"TOTAL",?25,"% OF TOTAL"
W !,"---------------------------------------"
S PAGE=PAGE+1
Q
;
NUMICNS ;EP - NUMBER OF ICNS POPULATED
; 8/31/2017 - CR 7708 - GCD - Added ability to run in summary mode. Moved totals to bottom of report. Moved header from OPTION file to here.
N IEN,POP,NOTPOP,HASCHART,PATS,DIR,DETAIL,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,AG
S DIR(0)="SB^S:SUMMARY;D:DETAIL"
S DIR("A")="RUN IN SUMMARY OR DETAIL MODE"
S DIR("B")="S"
D ^DIR
I "SD"'[Y Q
S DETAIL=(Y="D")
S AG("RPT")="",X="AGMP MPI ICN REPORT" D HDR^AG
S (POP,NOTPOP,HASCHART)=0
S IEN=0
F S IEN=$O(^DPT(IEN)) Q:'IEN D
.Q:$D(^DPT(IEN,-9))
.Q:'$O(^AUPNPAT(IEN,41,0))
.I $$DEMOPAT^AGMPHLU(IEN) Q ; 9/13/2017 - GCD - CR 7713 - Don't count demo patients.
.S HASCHART=0
.S DUZ2=0
.F S DUZ2=$O(^AUPNPAT(IEN,41,DUZ2)) Q:'DUZ2 D
..Q:$P($G(^AGFAC(DUZ2,0)),U,21)'="Y"
..S HASCHART=1
.Q:'HASCHART ;DON'T COUNT IF PT HAS NO CHARTS
.I $P($G(^DPT(IEN,"MPI")),U)'="" S POP=POP+1
.E S NOTPOP=NOTPOP+1 S:DETAIL PATS(IEN)=""
I DETAIL,NOTPOP>0 D
.W !!,"PATIENTS NOT POPULATED"
.W !,"----------------------"
.S IEN=""
.F S IEN=$O(PATS(IEN)) Q:'IEN D
..W !,$P($G(^DPT(IEN,0)),U)
W !!,"NUMBER OF ICNs POPULATED: ",POP
W !,"NUMBER NOT POPULATED: ",NOTPOP
I '$D(ZTQUEUED) D
.W !
.K DIR
.S DIR(0)="E"
.D ^DIR
Q
;
FINDMFK ;EP - FIND MFK MSG WITH AN UNSUCCESFUL MFE
N MSGIE,REC,COUNT,DASH
S %ZIS="MQ"
W !
D ^%ZIS
Q:POP
I $D(IO("Q")) D QUEMFK Q
U IO
PRTMFK ;EP - ENTRY POINT FOR TASKING
S $P(DASH,"-",81)=""
D NOW^%DTC S Y=% X ^DD("DD") S PRTDATE=Y
S $P(DASH,"-",81)=""
S PAGE=1
S ESC=0
D HDRMFK
S COUNT=0
S MSGIEN=0
F S MSGIEN=$O(^HLA(MSGIEN)) Q:'MSGIEN!ESC D
.Q:$P($G(^HLA(MSGIEN,0)),U,3)'="MFK"
.S REC=0
F S MSGIEN=$O(^HLA(MSGIEN)) Q:'MSGIEN!ESC D
.Q:$P($G(^HLA(MSGIEN,0)),U,3)'="MFK"
.S REC=0
.F S REC=$O(^HLA(MSGIEN,1,REC)) Q:'REC!ESC D
..Q:$P($G(^HLA(MSGIEN,1,REC,0)),U)'="MFA"
..S RESULT=$P($G(^HLA(MSGIEN,1,REC,0)),U,5)
..Q:RESULT="S"
..S MSGID=$P($G(^HLA(MSGIEN,0)),U)
..S COUNT=COUNT+1
..I $Y>(IOSL-4),(IO=IO(0)),'$D(IO("S")) K DIR S DIR(0)="E" D:'$D(ZTQUEUED) ^DIR S ESC=$G(X)=U Q:ESC D HDRMFK
..I $Y>(IOSL-4),$D(ZTQUEUED) D HDRMFK
..W !!,DASH
..W !,"HLA IEN: ",MSGIEN
..W !,"MSG ID: ",MSGID
..W !!,$G(^HLA(MSGIEN,1,REC-2,0))
..W !,$G(^HLA(MSGIEN,1,REC,0))
W !!!,"COUNT OF UNSUCCESSFUL MFE: ",COUNT
D ^%ZISC
I '$D(ZTQUEUED) D
.U 0
.W !
.K DIR
.S DIR(0)="E"
.D ^DIR
Q
;
HDRMFK ;EP - HEADER
W @IOF
W !,$$C^XBFUNC("UNSUCCESSFUL MFE REPORT",IOM)
W ?60,"PAGE ",PAGE
S PAGE=PAGE+1
W !,$$CJ^XLFSTR("DATE PRINTED: "_PRTDATE,IOM)
W !,$$CJ^XLFSTR("PRINTED BY: "_$P($G(^VA(200,DUZ,0)),U),IOM)
W !,DASH,!!
Q
;
QUEMFK ; EP - QUE MFE ERROR REPORT
S ZTRTN="PRTMFK^AGMPHLU1"
S ZTDESC="HLO MFE ERROR MESSAGE REPORT"
D ^%ZTLOAD
I $D(ZTSK)[0 W !!?5,"Report Cancelled!"
E W !!?5,"Report task #: ",$G(ZTSK)
D HOME^%ZIS
Q
;
RESETICN ;EP - CLEAR INTEGRATION CONTROL NUMBER
; 9/18/2017 - GCD - CR 7705 - Disabled this because it should never be run in the field.
Q
;
;OIT PROGRAMMER ONLY OPTION
;THIS IS USED IF A SITE NEEDS TO BE RELOADED INTO THE MPI
;FOR SOME REASON. PARTICULARLY WHEN A BETA SITE IS RELOADED AND THEREFORE
;PATIET ARE ASSIGNED NEW EUID BY THE MPI
ONE ;EP - RESET JUST ONE PATIENT
W !!,"USE THIS OPTION TO CLEAR THE INTEGRATION CONTROL NUMBER"
W !,"THIS CAN BE USED WHEN A SITE NEEDS TO BE RELOADED INTO THE MPI"
W !,"IF A SITE IS RELOADED THEN NEW EUIDs WILL BE ASSIGNED."
W !!
N DIR,DIC,DIE,DA,DR
S DIR(0)="YO"
S DIR("A")="RESET ALL PATIENTS"
Q:$D(DTOUT)!($D(DUOUT))!(Y="")
I Y="Y" D ALLRESET Q
W !,"ENTER PATIENT TO RESET"
D PTLK^AG
Q:'$D(DFN)
I '$D(^DPT(DFN,"MPI")) D G ONE
.W !!,"PATIENT HAS NO ICN"
.K DIR
.S DIR(0)="E"
.D ^DIR
S DA=DFN
S DIE="^DPT("
S DR="991.01///@;991.02///@"
D ^DIE
Q
ALLRESET ;EP - RESET ALL ICNs THAT ARE POPULATED
; 9/18/2017 - GCD - CR 7705 - Disabled this because it should never be run in the field.
Q
;
;OIT PROGRAMMER ONLY OPTION
N DIR,DIC,DIE,DA,DR
S DIE="^DPT("
S DR="991.01///@;991.02///@"
S DA=0
F S DA=$O(^DPT(DA)) Q:'DA D
.Q:'$D(^DPT(DA,"MPI"))
.D ^DIE
Q
;
CLEARALL ;EP - RESET ALL FOR RETESTING SESSION
;OIT PROGRAMMER ONLY OPTION
;D CLEAR
;D ALLRESET
;K ^DGCN(391.91)
;S ^DGCN(391.91,0)="TREATING FACILITY LIST^391.91PI^^"
Q
;CLEAR HLO MESSAGE GLOBALS
CLEAR ;EP - CLEAR HLO MESSAGE GLOBALS
;OIT PROGRAMMER ONLY OPTION
;K ^HLA,^HLB,^HLC,^HLTMP
;S ^HLA(0)="HLO MESSAGE BODY^777DI^^"
;S ^HLB(0)="HLO MESSAGES^778O^^"
Q
;
QUEVSENT ;EP - MSGS IN QUEUE VS TOTAL MSGS
G QUEVSENT^AGMPHLU2 ; 9/25/2017 - GCD - Moved to reduce routine size
AGMPHLU1 ; IHS/SD/TPF - MPI HLO UTILITIES ; 12/15/2007
+1 ;;7.2;IHS PATIENT REGISTRATION;**1,6**;JAN 07, 2011;Build 23
+2 QUIT
+3 ;
+4 ;OIT PROGRAMMER USE ONLY - NO OPTION
LOADTST(EVENT,START,LASTCNT) ;EP - TEST MPI LOAD
+1 ; 9/18/2017 - GCD - CR 7705 - Disabled this because it should never be run in the field.
+2 QUIT
+3 ;
+4 NEW IEN,COUNT,CNT
+5 SET COUNT=0
+6 SET IEN=$GET(START)
+7 IF IEN=""
SET IEN=0
+8 FOR CNT=1:1
SET IEN=$ORDER(^DPT(IEN))
IF 'IEN!(COUNT>LASTCNT)
QUIT
Begin DoDot:1
+9 ;DURING TESTING DON'T SEND IF ALREADY SENT
IF $PIECE($GET(^DPT(IEN,"MPI")),U)'=""
QUIT
+10 IF $DATA(^DPT(IEN,-9))
QUIT
+11 IF '$ORDER(^AUPNPAT(IEN,41,0))
QUIT
+12 ; 9/13/2017 - GCD - CR 7713 - Don't upload demo patients.
IF $$DEMOPAT^AGMPHLU($GET(IEN))
QUIT
+13 SET COUNT=COUNT+1
+14 IF '(CNT#100)
WRITE "."
+15 DO NOW^%DTC
SET NOW=%
+16 IF EVENT="A01"
DO CREATE^AGMPHL01(4,IEN,NOW)
QUIT
+17 IF EVENT="A03"
DO CREATE^AGMPHL03(1,IEN,"T"_NOW)
QUIT
+18 DO CREATMSG^AGMPIHLO(IEN,EVENT)
End DoDot:1
+19 WRITE !,"TOTAL "_EVENT_" MESSAGES SENT: ",COUNT
+20 QUIT
+21 ;
FINDERR ;EP - SEACH FOR ERR IN ^HLA
FROMERR ;EP
+1 KILL DIR
+2 SET DIR(0)="DO^::E"
+3 SET DIR("A")="Enter from Date"
+4 SET DIR("B")="T"
+5 DO ^DIR
+6 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!(Y="")
QUIT
+7 SET FROMERR=Y
TOERR ;EP
+1 KILL DIR
+2 SET DIR(0)="DO^::E"
+3 SET DIR("A")="Enter to Date"
+4 SET DIR("B")="T"
+5 DO ^DIR
+6 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!(Y="")
GOTO FROMERR
+7 SET TOERR=Y_".999999"
+8 IF FROMERR>TOERR
Begin DoDot:1
+9 WRITE !!,"FROM DATE CAN NOT BE GREATER THAN TO DATE!!"
HANG 2
End DoDot:1
GOTO FROMERR
+10 SET FROMERR=FROMERR-.00001
SHOW ;EP
+1 KILL DIR
+2 SET DIR(0)="YO"
+3 SET DIR("A")="Display originating message"
+4 SET DIR("B")="N"
+5 DO ^DIR
+6 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!(Y="")
GOTO TOERR
+7 SET SHOW=Y
+8 WRITE !!,"FINDING ERR SEGMENTS IN HLA"
+9 NEW COUNT,MSG,DASH
+10 SET COUNT=0
+11 DO DOCOUNT(.COUNT)
+12 WRITE !!,"THERE WERE "_COUNT_" ERR ERRORS FOUND"
+13 IF COUNT=0
Begin DoDot:1
+14 KILL DIR
+15 SET DIR(0)="E"
+16 DO ^DIR
End DoDot:1
QUIT
+17 SET %ZIS="MQ"
+18 WRITE !
+19 DO ^%ZIS
+20 IF POP
QUIT
+21 IF $DATA(IO("Q"))
DO QUEERR
QUIT
+22 USE IO
QUEPRINT ;EP ENTER FROM TASKMAN
+1 SET $PIECE(DASH,"-",81)=""
+2 NEW CODECNT
+3 SET TOTCOUNT=0
+4 SET ESC=0
+5 SET PAGE=1
+6 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET PRTDATE=Y
+7 DO HDRERR
+8 SET MSGDATE=FROMERR-.0001
+9 FOR
SET MSGDATE=$ORDER(^HLA("B",MSGDATE))
IF MSGDATE=""!(ESC)
QUIT
Begin DoDot:1
+10 IF +MSGDATE>TOERR!(+MSGDATE<FROMERR)
QUIT
+11 SET MSGIEN=""
+12 FOR
SET MSGIEN=$ORDER(^HLA("B",MSGDATE,MSGIEN))
IF MSGIEN=""!(ESC)
QUIT
Begin DoDot:2
+13 SET LINK=$PIECE($GET(^HLB(MSGIEN,0)),U,5)
+14 IF LINK'="MPI"
QUIT
+15 ;W !,MSGDATE
+16 IF $PIECE($GET(^HLA(MSGIEN,1,3,0)),U)'="ERR"
QUIT
+17 SET ENTRYDT=$PIECE($GET(^HLA(MSGIEN,0)),U)
+18 SET ACKCODE=$PIECE($GET(^HLA(MSGIEN,1,1,0)),U,2)
+19 SET MSGID=$PIECE($GET(^HLA(MSGIEN,1,1,0)),U,3)
+20 SET OMSGIEN=$PIECE(MSGID," ",2)
+21 SET LOCALID=$PIECE($PIECE($GET(^HLA(OMSGIEN,1,3,0)),"|",3),"~")
+22 SET TOTCOUNT=TOTCOUNT+1
+23 IF $Y>(IOSL-4)
IF (IO=IO(0))
IF '$DATA(IO("S"))
KILL DIR
SET DIR(0)="E"
IF '$DATA(ZTQUEUED)
DO ^DIR
SET ESC=$GET(X)=U
IF ESC
QUIT
DO HDRERR
+24 IF $Y>(IOSL-4)
IF $DATA(ZTQUEUED)
DO HDRERR
+25 WRITE !!,DASH
+26 WRITE !,"PATIENT DFN: ",LOCALID
+27 WRITE !,"HLA IEN: ",MSGIEN
+28 WRITE !,"MSG ID: ",MSGID
+29 WRITE !,"ORIGINATING MSG IEN: ",OMSGIEN
+30 WRITE !,"ACK CODE: ",ACKCODE
+31 WRITE !,$GET(^HLA(MSGIEN,1,3,0))
+32 SET CODECNT(ACKCODE)=$GET(CODECNT(ACKCODE))+1
+33 IF SHOW
DO LISTOMSG(OMSGIEN)
End DoDot:2
End DoDot:1
+34 DO PRTERRCD(.CODECNT)
+35 WRITE !!!,"TOTAL ERRORS: ",TOTCOUNT
+36 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+37 USE 0
+38 WRITE !
+39 KILL DIR
+40 SET DIR(0)="E"
+41 DO ^DIR
End DoDot:1
+42 DO ^%ZISC
+43 QUIT
+44 ;
HDRERR ;EP - HEADER
+1 WRITE @IOF
+2 WRITE !,$$C^XBFUNC("MSG ERR REPORT",IOM)
+3 WRITE ?70,"PAGE ",PAGE
+4 SET PAGE=PAGE+1
+5 WRITE !,$$CJ^XLFSTR("DATE PRINTED: "_PRTDATE,IOM)
+6 WRITE !,$$CJ^XLFSTR("PRINTED BY: "_$PIECE($GET(^VA(200,DUZ,0)),U),IOM)
+7 WRITE !,DASH,!!
+8 QUIT
+9 ;
PRTERRCD(CODECNT) ;EP
+1 NEW ACKCODE
+2 SET ACKCODE=""
+3 FOR
SET ACKCODE=$ORDER(CODECNT(ACKCODE))
IF ACKCODE=""
QUIT
Begin DoDot:1
+4 WRITE !,"TOTAL "_ACKCODE_" ERRS: ",CODECNT(ACKCODE)
End DoDot:1
+5 QUIT
+6 ;
QUEERR ; EP - QUE AE ERROR REPORT
+1 SET ZTRTN="QUEPRINT^AGMPHLU1"
+2 SET ZTDESC="HLO AE ERROR MESSAGE REPORT"
+3 SET ZTSAVE("FROMERR")=""
+4 SET ZTSAVE("TOERR")=""
+5 SET ZTSAVE("SHOW")=""
+6 DO ^%ZTLOAD
+7 IF $DATA(ZTSK)[0
WRITE !!?5,"Report Cancelled!"
+8 IF '$TEST
WRITE !!?5,"Report task #: ",$GET(ZTSK)
+9 DO HOME^%ZIS
+10 QUIT
+11 ;
DOCOUNT(COUNT) ;EP - GET COUNT OF ERR MSGS
+1 SET MSGIEN=0
FOR
SET MSGIEN=$ORDER(^HLA(MSGIEN))
IF 'MSGIEN
QUIT
Begin DoDot:1
+2 SET ENTRYDT=$PIECE($GET(^HLA(MSGIEN,0)),U)
+3 IF ENTRYDT>TOERR!(ENTRYDT<FROMERR)
QUIT
+4 IF $PIECE($GET(^HLA(MSGIEN,1,3,0)),U)'="ERR"
QUIT
+5 SET COUNT=COUNT+1
End DoDot:1
+6 QUIT
+7 ;
LISTOMSG(OMSGIEN) ;EP - LIST ORIGINATING MESSAGE
+1 NEW DATA
+2 WRITE !!,"ORINATING MESSAGE:"
+3 SET REC=0
+4 FOR
SET REC=$ORDER(^HLA(OMSGIEN,1,REC))
IF 'REC
QUIT
Begin DoDot:1
+5 SET DATA=$GET(^HLA(OMSGIEN,1,REC,0))
+6 IF DATA=""
QUIT
+7 WRITE !,DATA
End DoDot:1
+8 QUIT
+9 ;
FINDSEG(SEG,SHOW) ;EP - FIND SEG SEGMENT IN MESSAGE
+1 ;YOU CAN USE THIS FOR ANY EN MASSE CHANGES
+2 ;OIT PROGRAMMER USE ONLY - NO OPTION
+3 NEW IEN,REC,MSGTYPE,FOUND
+4 SET FOUND=0
+5 IF SEG="MSH"
SET GLOREF="^HLB"
+6 IF '$TEST
SET GLOREF="^HLA"
+7 SET IEN=0
+8 FOR
SET IEN=$ORDER(@GLOREF@(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+9 IF SEG'="MSH"
Begin DoDot:2
+10 SET REC=0
+11 FOR
SET REC=$ORDER(@GLOREF@(IEN,1,REC))
IF 'REC
QUIT
Begin DoDot:3
+12 IF $PIECE($GET(@GLOREF@(IEN,1,REC,0)),U)'=SEG
QUIT
+13 ;PLACE ANY EDITS NEEDED HERE
+14 WRITE !,@GLOREF@(IEN,1,REC,0)
+15 SET TEMP=$PIECE(@GLOREF@(IEN,1,REC,0),U,45)
+16 SET DATE=$PIECE(TEMP," ")
+17 SET TIME=$PIECE(TEMP," ",2)
+18 WRITE !,"DATE: ",DATE
+19 WRITE !,"TIME: ",TIME
+20 SET FOUND=FOUND+1
+21 SET FOUND(IEN)=""
End DoDot:3
End DoDot:2
+22 ;EDITS TO MSH HEADER
IF '$TEST
Begin DoDot:2
+23 ;ONLY OUTGOING
IF $PIECE($GET(@GLOREF@(IEN,0)),U,4)'="O"
QUIT
+24 ;PLACE ANY EDITS NEEDED HERE
+25 WRITE !!!,"IEN: ",IEN
+26 WRITE !,$GET(@GLOREF@(IEN,1))
+27 WRITE !,$PIECE($GET(@GLOREF@(IEN,1)),U,6)
+28 ;S TEMP=$P($G(@GLOREF@(IEN,1)),U,6)
+29 ;I $P(TEMP,"~")="8990" Q
+30 ;S $P(TEMP,"~")="8990"
+31 ;B "S+"
+32 ;S $P(@GLOREF@(IEN,1),U,6)=TEMP
+33 SET FOUND=FOUND+1
+34 SET FOUND(IEN)=""
End DoDot:2
End DoDot:1
+35 WRITE !,"FOUND "_FOUND_" "_SEG_" IN MESSAGE"
+36 ;ZW FOUND
+37 QUIT
+38 ;
ASKEVN ;EP - ASK EVENT
+1 NEW EVENT,MSGTYPE,ACKCODE,ONLYCNT
+2 KILL DIR
+3 SET DIR(0)="SO^A28:ADD A PATIENT;A08:UPDATE A PATIENT;A40:MERGE PATIENTS"
+4 SET DIR(0)=DIR(0)_";A01:ADMIT/CHECKIN A PATIENT;A03:DISCHARGE/CHECK OUT A PATIENT"
+5 ;OR MFN?
SET DIR(0)=DIR(0)_";M05:TREATING FACILITY UPDATE"
+6 SET DIR("A")="ENTER EVENT"
+7 DO ^DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
+9 SET EVENT=Y
ASKTYPE ;EP - ASK MSG TYPE
+1 KILL DIR
+2 SET DIR(0)="SO^ADT:ADMIT DISCHARGE TRANSFER;ACK:ACKNOWLEDGEMENTS;MFN:TREATING FACILITY UPDATE"
+3 SET DIR("A")="ENTER MSG TYPE"
+4 DO ^DIR
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
GOTO ASKEVN
+6 SET MSGTYPE=Y
+7 ;B "S+"
+8 SET ACKCODE=""
+9 IF MSGTYPE="ACK"
Begin DoDot:1
+10 KILL DIR
+11 SET DIR(0)="SO^AA:APPLICATION ACCEPT;AE:APPLICATION ERROR;AR:APPLICATION REJECT"
+12 ;OR MFN?
SET DIR(0)=DIR(0)_";CA:COMMIT ACCEPT;CE:COMMIT ERROR;CR:COMMIT REJECT"
+13 SET DIR("A")="ENTER ACK CODE"
+14 DO ^DIR
+15 SET ACKCODE=Y
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT
ASKCNT ;EP - ASK IF ONLY A COUNT IS NEEDED
+1 KILL DIR
+2 SET DIR(0)="YO"
+3 SET DIR("A")="TOTALS ONLY"
+4 DO ^DIR
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
GOTO ASKTYPE
+6 SET ONLYCNT=Y=1
+7 SET %ZIS="MQ"
+8 WRITE !
+9 DO ^%ZIS
+10 IF POP
QUIT
+11 IF $DATA(IO("Q"))
DO QUEEVN
QUIT
+12 USE IO
FINDEVN ;EP - FIND EVENT
+1 ;FINDEVN("A28","ACK","CA")
+2 NEW IEN,REC,FOUND,DASH
+3 SET $PIECE(DASH,"-",81)=""
+4 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET PRTDATE=Y
+5 SET PAGE=1
+6 DO HDREVN
+7 SET ESC=0
+8 SET FOUND=0
+9 SET IEN=0
+10 FOR
SET IEN=$ORDER(^HLA(IEN))
IF 'IEN!ESC
QUIT
Begin DoDot:1
+11 IF EVENT'=""
IF $PIECE($GET(^HLA(IEN,0)),U,4)'=EVENT
QUIT
+12 IF MSGTYPE'=""
IF $PIECE($GET(^HLA(IEN,0)),U,3)'=MSGTYPE
QUIT
+13 IF $GET(^HLA(IEN,1,1,0))'[ACKCODE
QUIT
+14 IF $Y>(IOSL-4)
IF (IO=IO(0))
IF '$DATA(IO("S"))
KILL DIR
SET DIR(0)="E"
IF '$DATA(ZTQUEUED)
DO ^DIR
SET ESC=$GET(X)=U
IF ESC
QUIT
DO HDREVN
+15 IF $Y>(IOSL-4)
IF $DATA(ZTQUEUED)
DO HDREVN
+16 IF 'ONLYCNT
Begin DoDot:2
+17 WRITE !!,IEN_" *** "_$GET(^HLA(IEN,0))
+18 DO LISTOMSG(IEN)
End DoDot:2
+19 SET FOUND=FOUND+1
End DoDot:1
+20 WRITE !,"FOUND "_FOUND_" '"_EVENT_"' EVENTS IN ^HLA WITH MSGTPYE '"_MSGTYPE
+21 IF $GET(ACKCODE)'=""
WRITE "' AND ACKCODE '"_ACKCODE_"'"
+22 DO ^%ZISC
+23 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+24 USE 0
+25 WRITE !
+26 KILL DIR
+27 SET DIR(0)="E"
+28 DO ^DIR
End DoDot:1
+29 QUIT
+30 ;
QUEEVN ;EP -
+1 SET ZTRTN="FINDEVN^AGMPHLU1"
+2 SET ZTDESC="MPI FIND EVENT/TYPE/ACK REPORT"
+3 SET ZTSAVE("EVENT")=""
SET ZTSAVE("MSGTYPE")=""
SET ZTSAVE("ACKCODE")=""
+4 DO ^%ZTLOAD
+5 IF $DATA(ZTSK)[0
WRITE !!?5,"Report Cancelled!"
+6 IF '$TEST
WRITE !!?5,"Report task #: ",$GET(ZTSK)
+7 DO HOME^%ZIS
+8 QUIT
+9 ;
HDREVN ;EP -
+1 WRITE @IOF
+2 WRITE !,$$C^XBFUNC("MPI FIND EVENT/TYPE/ACK REPORT",IOM)
+3 WRITE ?70,"PAGE ",PAGE
+4 WRITE !,$$CJ^XLFSTR("DATE PRINTED: "_PRTDATE,IOM)
+5 WRITE !,$$CJ^XLFSTR("PRINTED BY: "_$PIECE($GET(^VA(200,DUZ,0)),U),IOM)
+6 WRITE !,DASH,!!
+7 SET PAGE=PAGE+1
+8 QUIT
+9 ;
RPTBYDT ;EP - REPORT OF MSG TYPE AND EVENT BY DATE RANGE
+1 NEW MSGTYPE,EVENT,FROM,TO,MSGDATE,REC,MSGTYPCT,EVENTCNT,TOTMSG,TYPEEVNT,DASH,ESC
ASKFROM ;EP
+1 KILL DIR
+2 SET DIR(0)="DO^::E"
+3 SET DIR("A")="Enter from Date"
+4 SET DIR("B")="T"
+5 DO ^DIR
+6 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!(Y="")
QUIT
+7 SET FROM=Y
ASKTO ;EP
+1 KILL DIR
+2 SET DIR(0)="DO^::E"
+3 SET DIR("A")="Enter to Date"
+4 SET DIR("B")="T"
+5 DO ^DIR
+6 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!(Y="")
GOTO ASKFROM
+7 SET TO=Y_".999999"
+8 IF FROM>TO
Begin DoDot:1
+9 WRITE !!,"FROM DATE CAN NOT BE GREATER THAN TO DATE!!"
HANG 2
End DoDot:1
GOTO ASKFROM
REPEAT ;EP -
+1 SET TYPEEVNT=""
FOR
SET TYPEEVNT=$ORDER(TYPEEVNT(TYPEEVNT))
IF TYPEEVNT=""
QUIT
SET TYPEEVNT(TYPEEVNT)=0
+2 SET ESC=0
+3 SET TOTMSG=0
+4 SET MSGDATE=FROM-.01
+5 FOR
SET MSGDATE=$ORDER(^HLA("B",MSGDATE))
IF MSGDATE=""!(ESC)
QUIT
Begin DoDot:1
+6 IF +MSGDATE>TO!(+MSGDATE<FROM)
QUIT
+7 SET REC=""
+8 FOR
SET REC=$ORDER(^HLA("B",MSGDATE,REC))
IF REC=""
QUIT
Begin DoDot:2
+9 SET LINK=$PIECE($GET(^HLB(REC,0)),U,5)
+10 IF LINK'="MPI"
QUIT
+11 SET MSGTYPE=$PIECE($GET(^HLA(REC,0)),U,3)
+12 SET EVENT=$PIECE($GET(^HLA(REC,0)),U,4)
+13 SET TYPEEVNT=EVENT_U_MSGTYPE
+14 SET TYPEEVNT(TYPEEVNT)=$GET(TYPEEVNT(TYPEEVNT))+1
+15 SET TOTMSG=TOTMSG+1
End DoDot:2
End DoDot:1
+16 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET PRTDATE=Y
+17 SET PAGE=1
+18 SET ESC=0
+19 SET $PIECE(DASH,"-",81)=""
+20 DO BYDTHDR
+21 SET FIRST=""
+22 SET TYPEEVNT=""
+23 FOR CNT=1:1
SET TYPEEVNT=$ORDER(TYPEEVNT(TYPEEVNT))
IF TYPEEVNT=""!ESC
QUIT
Begin DoDot:1
+24 IF CNT'=1
IF (FIRST'=$PIECE(TYPEEVNT,U))
WRITE !!
+25 SET FIRST=$PIECE(TYPEEVNT,U)
+26 WRITE !,TYPEEVNT,?12,$JUSTIFY(TYPEEVNT(TYPEEVNT),10)
+27 WRITE ?25,$JUSTIFY($FNUMBER(TYPEEVNT(TYPEEVNT)/TOTMSG*100,",",2),10)
End DoDot:1
+28 WRITE !,"---------------------------------------"
+29 WRITE !!,"TOTAL MSGS: ",$JUSTIFY(TOTMSG,10)
+30 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+31 USE 0
+32 WRITE !
+33 KILL DIR
+34 SET DIR(0)="E"
+35 DO ^DIR
End DoDot:1
SET ESC=X=U
IF ESC
QUIT
+36 IF '$DATA(ZTQUEUED)
GOTO REPEAT
+37 QUIT
+38 ;
BYDTHDR ;EP - RPTBYDT HEADER
+1 WRITE @IOF
+2 WRITE !,$$C^XBFUNC("MESSAGE REPORT BY DATE",IOM)
+3 WRITE ?70,"PAGE ",PAGE
+4 WRITE !,$$CJ^XLFSTR("DATE PRINTED: "_PRTDATE,IOM)
+5 WRITE !,$$CJ^XLFSTR("PRINTED BY: "_$PIECE($GET(^VA(200,DUZ,0)),U),IOM)
+6 WRITE !,$$CJ^XLFSTR("AT FACILITY: "_$PIECE($GET(^DIC(4,DUZ(2),0)),U),IOM)
+7 SET Y=FROM
XECUTE ^DD("DD")
SET EXFROM=Y
+8 SET Y=TO
XECUTE ^DD("DD")
SET EXTO=Y
+9 WRITE !,$$CJ^XLFSTR("FOR MESSAGES FROM "_EXFROM_" TO "_EXTO,IOM)
+10 WRITE !,DASH,!!
+11 WRITE !!,"EVENT^TYPE",?16,"TOTAL",?25,"% OF TOTAL"
+12 WRITE !,"---------------------------------------"
+13 SET PAGE=PAGE+1
+14 QUIT
+15 ;
NUMICNS ;EP - NUMBER OF ICNS POPULATED
+1 ; 8/31/2017 - CR 7708 - GCD - Added ability to run in summary mode. Moved totals to bottom of report. Moved header from OPTION file to here.
+2 NEW IEN,POP,NOTPOP,HASCHART,PATS,DIR,DETAIL,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,AG
+3 SET DIR(0)="SB^S:SUMMARY;D:DETAIL"
+4 SET DIR("A")="RUN IN SUMMARY OR DETAIL MODE"
+5 SET DIR("B")="S"
+6 DO ^DIR
+7 IF "SD"'[Y
QUIT
+8 SET DETAIL=(Y="D")
+9 SET AG("RPT")=""
SET X="AGMP MPI ICN REPORT"
DO HDR^AG
+10 SET (POP,NOTPOP,HASCHART)=0
+11 SET IEN=0
+12 FOR
SET IEN=$ORDER(^DPT(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+13 IF $DATA(^DPT(IEN,-9))
QUIT
+14 IF '$ORDER(^AUPNPAT(IEN,41,0))
QUIT
+15 ; 9/13/2017 - GCD - CR 7713 - Don't count demo patients.
IF $$DEMOPAT^AGMPHLU(IEN)
QUIT
+16 SET HASCHART=0
+17 SET DUZ2=0
+18 FOR
SET DUZ2=$ORDER(^AUPNPAT(IEN,41,DUZ2))
IF 'DUZ2
QUIT
Begin DoDot:2
+19 IF $PIECE($GET(^AGFAC(DUZ2,0)),U,21)'="Y"
QUIT
+20 SET HASCHART=1
End DoDot:2
+21 ;DON'T COUNT IF PT HAS NO CHARTS
IF 'HASCHART
QUIT
+22 IF $PIECE($GET(^DPT(IEN,"MPI")),U)'=""
SET POP=POP+1
+23 IF '$TEST
SET NOTPOP=NOTPOP+1
IF DETAIL
SET PATS(IEN)=""
End DoDot:1
+24 IF DETAIL
IF NOTPOP>0
Begin DoDot:1
+25 WRITE !!,"PATIENTS NOT POPULATED"
+26 WRITE !,"----------------------"
+27 SET IEN=""
+28 FOR
SET IEN=$ORDER(PATS(IEN))
IF 'IEN
QUIT
Begin DoDot:2
+29 WRITE !,$PIECE($GET(^DPT(IEN,0)),U)
End DoDot:2
End DoDot:1
+30 WRITE !!,"NUMBER OF ICNs POPULATED: ",POP
+31 WRITE !,"NUMBER NOT POPULATED: ",NOTPOP
+32 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+33 WRITE !
+34 KILL DIR
+35 SET DIR(0)="E"
+36 DO ^DIR
End DoDot:1
+37 QUIT
+38 ;
FINDMFK ;EP - FIND MFK MSG WITH AN UNSUCCESFUL MFE
+1 NEW MSGIE,REC,COUNT,DASH
+2 SET %ZIS="MQ"
+3 WRITE !
+4 DO ^%ZIS
+5 IF POP
QUIT
+6 IF $DATA(IO("Q"))
DO QUEMFK
QUIT
+7 USE IO
PRTMFK ;EP - ENTRY POINT FOR TASKING
+1 SET $PIECE(DASH,"-",81)=""
+2 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET PRTDATE=Y
+3 SET $PIECE(DASH,"-",81)=""
+4 SET PAGE=1
+5 SET ESC=0
+6 DO HDRMFK
+7 SET COUNT=0
+8 SET MSGIEN=0
+9 FOR
SET MSGIEN=$ORDER(^HLA(MSGIEN))
IF 'MSGIEN!ESC
QUIT
Begin DoDot:1
+10 IF $PIECE($GET(^HLA(MSGIEN,0)),U,3)'="MFK"
QUIT
+11 SET REC=0
End DoDot:1
+12 FOR
SET MSGIEN=$ORDER(^HLA(MSGIEN))
IF 'MSGIEN!ESC
QUIT
Begin DoDot:1
+13 IF $PIECE($GET(^HLA(MSGIEN,0)),U,3)'="MFK"
QUIT
+14 SET REC=0
+15 FOR
SET REC=$ORDER(^HLA(MSGIEN,1,REC))
IF 'REC!ESC
QUIT
Begin DoDot:2
+16 IF $PIECE($GET(^HLA(MSGIEN,1,REC,0)),U)'="MFA"
QUIT
+17 SET RESULT=$PIECE($GET(^HLA(MSGIEN,1,REC,0)),U,5)
+18 IF RESULT="S"
QUIT
+19 SET MSGID=$PIECE($GET(^HLA(MSGIEN,0)),U)
+20 SET COUNT=COUNT+1
+21 IF $Y>(IOSL-4)
IF (IO=IO(0))
IF '$DATA(IO("S"))
KILL DIR
SET DIR(0)="E"
IF '$DATA(ZTQUEUED)
DO ^DIR
SET ESC=$GET(X)=U
IF ESC
QUIT
DO HDRMFK
+22 IF $Y>(IOSL-4)
IF $DATA(ZTQUEUED)
DO HDRMFK
+23 WRITE !!,DASH
+24 WRITE !,"HLA IEN: ",MSGIEN
+25 WRITE !,"MSG ID: ",MSGID
+26 WRITE !!,$GET(^HLA(MSGIEN,1,REC-2,0))
+27 WRITE !,$GET(^HLA(MSGIEN,1,REC,0))
End DoDot:2
End DoDot:1
+28 WRITE !!!,"COUNT OF UNSUCCESSFUL MFE: ",COUNT
+29 DO ^%ZISC
+30 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+31 USE 0
+32 WRITE !
+33 KILL DIR
+34 SET DIR(0)="E"
+35 DO ^DIR
End DoDot:1
+36 QUIT
+37 ;
HDRMFK ;EP - HEADER
+1 WRITE @IOF
+2 WRITE !,$$C^XBFUNC("UNSUCCESSFUL MFE REPORT",IOM)
+3 WRITE ?60,"PAGE ",PAGE
+4 SET PAGE=PAGE+1
+5 WRITE !,$$CJ^XLFSTR("DATE PRINTED: "_PRTDATE,IOM)
+6 WRITE !,$$CJ^XLFSTR("PRINTED BY: "_$PIECE($GET(^VA(200,DUZ,0)),U),IOM)
+7 WRITE !,DASH,!!
+8 QUIT
+9 ;
QUEMFK ; EP - QUE MFE ERROR REPORT
+1 SET ZTRTN="PRTMFK^AGMPHLU1"
+2 SET ZTDESC="HLO MFE ERROR MESSAGE REPORT"
+3 DO ^%ZTLOAD
+4 IF $DATA(ZTSK)[0
WRITE !!?5,"Report Cancelled!"
+5 IF '$TEST
WRITE !!?5,"Report task #: ",$GET(ZTSK)
+6 DO HOME^%ZIS
+7 QUIT
+8 ;
RESETICN ;EP - CLEAR INTEGRATION CONTROL NUMBER
+1 ; 9/18/2017 - GCD - CR 7705 - Disabled this because it should never be run in the field.
+2 QUIT
+3 ;
+4 ;OIT PROGRAMMER ONLY OPTION
+5 ;THIS IS USED IF A SITE NEEDS TO BE RELOADED INTO THE MPI
+6 ;FOR SOME REASON. PARTICULARLY WHEN A BETA SITE IS RELOADED AND THEREFORE
+7 ;PATIET ARE ASSIGNED NEW EUID BY THE MPI
ONE ;EP - RESET JUST ONE PATIENT
+1 WRITE !!,"USE THIS OPTION TO CLEAR THE INTEGRATION CONTROL NUMBER"
+2 WRITE !,"THIS CAN BE USED WHEN A SITE NEEDS TO BE RELOADED INTO THE MPI"
+3 WRITE !,"IF A SITE IS RELOADED THEN NEW EUIDs WILL BE ASSIGNED."
+4 WRITE !!
+5 NEW DIR,DIC,DIE,DA,DR
+6 SET DIR(0)="YO"
+7 SET DIR("A")="RESET ALL PATIENTS"
+8 IF $DATA(DTOUT)!($DATA(DUOUT))!(Y="")
QUIT
+9 IF Y="Y"
DO ALLRESET
QUIT
+10 WRITE !,"ENTER PATIENT TO RESET"
+11 DO PTLK^AG
+12 IF '$DATA(DFN)
QUIT
+13 IF '$DATA(^DPT(DFN,"MPI"))
Begin DoDot:1
+14 WRITE !!,"PATIENT HAS NO ICN"
+15 KILL DIR
+16 SET DIR(0)="E"
+17 DO ^DIR
End DoDot:1
GOTO ONE
+18 SET DA=DFN
+19 SET DIE="^DPT("
+20 SET DR="991.01///@;991.02///@"
+21 DO ^DIE
+22 QUIT
ALLRESET ;EP - RESET ALL ICNs THAT ARE POPULATED
+1 ; 9/18/2017 - GCD - CR 7705 - Disabled this because it should never be run in the field.
+2 QUIT
+3 ;
+4 ;OIT PROGRAMMER ONLY OPTION
+5 NEW DIR,DIC,DIE,DA,DR
+6 SET DIE="^DPT("
+7 SET DR="991.01///@;991.02///@"
+8 SET DA=0
+9 FOR
SET DA=$ORDER(^DPT(DA))
IF 'DA
QUIT
Begin DoDot:1
+10 IF '$DATA(^DPT(DA,"MPI"))
QUIT
+11 DO ^DIE
End DoDot:1
+12 QUIT
+13 ;
CLEARALL ;EP - RESET ALL FOR RETESTING SESSION
+1 ;OIT PROGRAMMER ONLY OPTION
+2 ;D CLEAR
+3 ;D ALLRESET
+4 ;K ^DGCN(391.91)
+5 ;S ^DGCN(391.91,0)="TREATING FACILITY LIST^391.91PI^^"
+6 QUIT
+7 ;CLEAR HLO MESSAGE GLOBALS
CLEAR ;EP - CLEAR HLO MESSAGE GLOBALS
+1 ;OIT PROGRAMMER ONLY OPTION
+2 ;K ^HLA,^HLB,^HLC,^HLTMP
+3 ;S ^HLA(0)="HLO MESSAGE BODY^777DI^^"
+4 ;S ^HLB(0)="HLO MESSAGES^778O^^"
+5 QUIT
+6 ;
QUEVSENT ;EP - MSGS IN QUEUE VS TOTAL MSGS
+1 ; 9/25/2017 - GCD - Moved to reduce routine size
GOTO QUEVSENT^AGMPHLU2
