MPIFBT1 ;SLC/ARS/SFCIO/CMC-BATCH QUERY TO MPI ;FEB 4, 1997
;;1.0; MASTER PATIENT INDEX VISTA ;**17,28,33**;30 Apr 99
;
; Integration Agreements Utilized:
; EXC, START, STOP^RGHLLOG - #2796
; ^DPT("ACMORS" - #2070
; ^RGSITE(991.8,1,"CMOR" - #2746
;
GOBKG ;
K STOP
;make sure only one job will run
L +^XTMP("MPIF BATCH LOAD"):3 E W !,"JOB ALREADY RUNNING" Q
;
I '$D(^RGSITE(991.8,1,"CMOR")) W !,"CMOR Scores NOT Complete" G EXIT
I $D(^RGSITE(991.8,1,"CMOR")),$P($G(^RGSITE(991.8,1,"CMOR")),"^",7)'="SN" W !,"CMOR Scores NOT Complete" G EXIT
;
;Check to see if job had STOPed -start where left off, start over or quit
I $P($G(^MPIF(984.8,1,0)),"^",6)'="" D AGAIN
I $D(STOP) W !,"Job NOT Started" K STOP G EXIT
D BEG
I $D(STOP) K STOP G EXIT
S ZTRTN="GO^MPIFBT1",ZTDESC="USE HL7 MSGS AND MAIL TO BUILD ICN"
S ZTIO="",ZTDTH=START
I $D(DUZ) S ZTSAVE("DUZ")=DUZ
I $D(ORDER) S ZTSAVE("ORDER")=ORDER
D ^%ZTLOAD W:$D(ZTSK) !,"TASK #: ",ZTSK
D HOME^%ZIS K IO("Q")
K ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,ORDER,START,ENDT
Q
EXIT ;
L -^XTMP("MPIF BATCH LOAD")
Q
;
BEG K DIR,DIE,DR,DA,X,Y
S DIR(0)="D^::AEFT",DIR("B")="NOW",DIR("A")="START TIME"
D ^DIR
I $D(DTOUT)!($D(DUOUT)) W !,"Job NOT Scheduled" K DTOUT,DUOUT,DIR,DA,X,Y S STOP="" Q
S START=Y
D DD^%DT
S ENDT=Y
TRY K DIR,DIE,DR,DA,X,Y
S DIR(0)="D^::AEFT",DIR("B")=ENDT,DIR("A")="STOP TIME"
D ^DIR
I $D(DTOUT)!($D(DUOUT)) W !,"Job NOT Scheduled" K DTOUT,DUOUT,DIR,DA,X,Y S STOP="" Q
I Y'>START W !,"Stop Time must be greater than Start Time" G TRY
D DD^%DT
S ENDT=Y
K DIR,DIE,DR,DA,X,Y
S DIE="^MPIF(984.8,",DR="9///"_ENDT,DA=1 D ^DIE
K DIE,X,Y,DA,DR
I $D(DTOUT)!($D(DUOUT)) W !,"Job NOT Scheduled" K DTOUT,DUOUT,DIR,DA,X,Y S STOP="" Q
Q
;
GO ;ENTRY POINT
I '$D(ZTQUEUED) L +^XTMP("MPIF BATCH LOAD"):3 E W !,"JOB ALREADY RUNNING" Q
I '$D(ZTQUEUED),('$D(^RGSITE(991.8,1,"CMOR"))) W !,"CMOR Scores NOT Complete" G EXIT
I '$D(ZTQUEUED),$D(^RGSITE(991.8,1,"CMOR")),$P($G(^RGSITE(991.8,1,"CMOR")),"^",7)'="SN" W !,"CMOR Scores NOT Complete" G EXIT
K STOP
;Check to see if job had STOPed-start where left off, start over or quit
I '$D(ZTQUEUED),$P($G(^MPIF(984.8,1,0)),"^",6)'="" D AGAIN
I $D(STOP) W !,"Job NOT Started" K STOP G EXIT
I '$D(ZTQUEUED) D BEG
I $D(STOP) K STOP G EXIT
GO1 K ^TMP("HLS",$J)
N MPIMORE,MPITOT
I $D(ZTQUEUED) S ZTREQ="@"
S QUITIME=$P(^MPIF(984.8,1,0),"^",10)
I '$D(ORDER) S ORDER=0
;
K ^TMP("HLS",$J)
S MPICNT=$S($P(^MPIF(984.8,1,0),"^",9)>1:$P(^MPIF(984.8,1,0),"^",9),1:1)
I +ORDER<1 S ORDER=0
D WORK
I $D(^TMP("HLS",$J)) D SEND
D STOP^RGHLLOG(0)
K MPIIT,MPITOT,HLDT,HLDT1,MPICNT,MPIDNUM,MPIEROR,MPIMIDT,MPIMSH
K MPIOUT,MPIQRYNM,MPISEQ,ORDER,QCNT,QUITIME,MPIMCNT,MPIMTX,ORDER,START
K ENDT
L -^XTMP("MPIF BATCH LOAD")
Q
WORK ;
Q:$P(^MPIF(984.8,1,0),"^",6)="STOP"
D NOW^%DTC
S $P(^MPIF(984.8,1,0),"^",2)=%
I %>QUITIME Q
S MPIMCNT="",MPIMTX=""
D HLRDF,LOOP
Q
;
HLRDF ;
S (MPIOUT,MPIMCNT)=""
S HL("ECH")="^~\&"
S HL("FS")="|"
D INIT^HLFNC2("MPIF ICN-Q02 SERVER",.HL)
I $O(HL("")) S ^TMP($J,"MPIF","ERR")=HL
D CREATE^HLTF(.MPIMCNT,.MPIMTX,.HLDT,.HLDT1)
D START^RGHLLOG()
Q:$P(^MPIF(984.8,1,0),"^",6)="STOP"
S $P(^MPIF(984.8,1,0),"^",7)=MPIMCNT
S $P(^MPIF(984.8,1,0),"^",8)=MPIMTX
Q
LOOP ;
Q:$P(^MPIF(984.8,1,0),"^",6)="STOP"
S MPIDNUM=1
D MAKE
Q
SEND ;ready to send
S $P(^MPIF(984.8,1,0),"^",5)="GENERATE TAG"
D GENERATE^HLMA("MPIF ICN-Q02 SERVER","GB",1,.MPIMTX,.MPIEROR,.MPIMORE)
I +MPIEROR=0 S ^TMP($J,"MPIF","ERR")=MPIEROR
D NOW^%DTC
S $P(^MPIF(984.8,1,0),"^",3)=%
K %,MPIMTX,MPIEROR,MPIMORE
K ^TMP("HLS",$J)
Q
MAKE ;
F S ORDER=$O(^DPT("ACMORS",ORDER)) Q:ORDER=""!($P(^MPIF(984.8,1,0),"^",6)="STOP") D
.S MPIIT=0
.F S MPIIT=$O(^DPT("ACMORS",ORDER,MPIIT)) Q:MPIIT=""!($P(^MPIF(984.8,1,0),"^",6)="STOP") D
..D MAKE3
..D NOW^%DTC
..I %>QUITIME S $P(^MPIF(984.8,1,0),"^",6)="STOP"
Q
MAKE3 ;
K MPIOUT
Q:$P(^MPIF(984.8,1,0),"^",6)="STOP"
S $P(^MPIF(984.8,1,0),"^",5)="LOOPING: "_MPIDNUM
S:$G(MPIQRYNM)="" MPIQRYNM="VTQ_PID_ICN_LOAD_1"
D VTQ1^MPIFVTQ(MPIIT,.MPIOUT,.HL,.MPIQRYNM)
I $P(MPIOUT(0),"^",1)<0,$P(MPIOUT(0),"^",2)="invalid DFN"!($P(MPIOUT(0),"^",2)="no encoding characters") D
.D EXC^RGHLLOG(206,"DFN = "_MPIIT_" Problem with building VTQ was "_$P(MPIOUT(0),"^",2),MPIIT) Q
;I $P(MPIOUT(0),"^")<0,$P(MPIOUT(0),"^",2)="Missing Required Field(s)" D EXC^RGHLLOG(209,"DFN - "_MPIIT_" Missing Required Field(s)",MPIIT) Q
Q:$P(MPIOUT(0),"^")<0
;call for HL7 header
S MPIMIDT=MPIMCNT_"-"_MPIDNUM
D MSH^HLFNC2(.HL,MPIMIDT,.MPIMSH)
S MPIOUT(1)=MPIMSH
;MESSAGE BUILT
S MPISEQ=0
F S MPISEQ=$O(MPIOUT(MPISEQ)) Q:MPISEQ'>0 D
.S ^TMP("HLS",$J,MPICNT)=MPIOUT(MPISEQ)
.S MPICNT=MPICNT+1
S $P(^MPIF(984.8,1,0),"^",11)=ORDER
S $P(^MPIF(984.8,1,0),"^",9)=MPICNT
S $P(^MPIF(984.8,1,0),"^",4)=MPIIT
S MPIDNUM=MPIDNUM+1
I MPIDNUM>100 D
.D SEND
.S (MPICNT,MPIDNUM)=1
.D HLRDF
Q
;
AGAIN ;job started before
W !,"Job was started before and has Stopped"
K DIR,DR
S DIR(0)="Y",DIR("B")="YES",DIR("A")="Begin Where Left Off? ",DIR("?")="Y for yes to start where job left off, N for no"
D ^DIR
I Y=1 S ORDER=$P(^MPIF(984.8,1,0),"^",11),$P(^MPIF(984.8,1,0),"^",6)="" G END
;job started but used doesn't want to start where job left off
W !,"'E' - Exit or 'O' - Start over from the Beginning"
K DIR,DR
S DIR(0)="S^E:EXIT;O:OVER",DIR("?")="E for Exit, O to Start Over from the Beginning"
S DIR("A")="What would you like to do?"
D ^DIR
S:Y="E" STOP=""
S:Y="O" ORDER=0,$P(^MPIF(984.8,1,0),"^",6)=""
END ;
K DIR,Y,DR,X
; wants to start over or from where job left off if '$d(stop)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFBT1 5760 printed Apr 09, 2024@21:13:34 Page 2
MPIFBT1 ;SLC/ARS/SFCIO/CMC-BATCH QUERY TO MPI ;FEB 4, 1997
+1 ;;1.0; MASTER PATIENT INDEX VISTA ;**17,28,33**;30 Apr 99
+2 ;
+3 ; Integration Agreements Utilized:
+4 ; EXC, START, STOP^RGHLLOG - #2796
+5 ; ^DPT("ACMORS" - #2070
+6 ; ^RGSITE(991.8,1,"CMOR" - #2746
+7 ;
GOBKG ;
+1 KILL STOP
+2 ;make sure only one job will run
+3 LOCK +^XTMP("MPIF BATCH LOAD"):3
IF '$TEST
WRITE !,"JOB ALREADY RUNNING"
QUIT
+4 ;
+5 IF '$DATA(^RGSITE(991.8,1,"CMOR"))
WRITE !,"CMOR Scores NOT Complete"
GOTO EXIT
+6 IF $DATA(^RGSITE(991.8,1,"CMOR"))
IF $PIECE($GET(^RGSITE(991.8,1,"CMOR")),"^",7)'="SN"
WRITE !,"CMOR Scores NOT Complete"
GOTO EXIT
+7 ;
+8 ;Check to see if job had STOPed -start where left off, start over or quit
+9 IF $PIECE($GET(^MPIF(984.8,1,0)),"^",6)'=""
DO AGAIN
+10 IF $DATA(STOP)
WRITE !,"Job NOT Started"
KILL STOP
GOTO EXIT
+11 DO BEG
+12 IF $DATA(STOP)
KILL STOP
GOTO EXIT
+13 SET ZTRTN="GO^MPIFBT1"
SET ZTDESC="USE HL7 MSGS AND MAIL TO BUILD ICN"
+14 SET ZTIO=""
SET ZTDTH=START
+15 IF $DATA(DUZ)
SET ZTSAVE("DUZ")=DUZ
+16 IF $DATA(ORDER)
SET ZTSAVE("ORDER")=ORDER
+17 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"TASK #: ",ZTSK
+18 DO HOME^%ZIS
KILL IO("Q")
+19 KILL ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,ORDER,START,ENDT
+20 QUIT
EXIT ;
+1 LOCK -^XTMP("MPIF BATCH LOAD")
+2 QUIT
+3 ;
BEG KILL DIR,DIE,DR,DA,X,Y
+1 SET DIR(0)="D^::AEFT"
SET DIR("B")="NOW"
SET DIR("A")="START TIME"
+2 DO ^DIR
+3 IF $DATA(DTOUT)!($DATA(DUOUT))
WRITE !,"Job NOT Scheduled"
KILL DTOUT,DUOUT,DIR,DA,X,Y
SET STOP=""
QUIT
+4 SET START=Y
+5 DO DD^%DT
+6 SET ENDT=Y
TRY KILL DIR,DIE,DR,DA,X,Y
+1 SET DIR(0)="D^::AEFT"
SET DIR("B")=ENDT
SET DIR("A")="STOP TIME"
+2 DO ^DIR
+3 IF $DATA(DTOUT)!($DATA(DUOUT))
WRITE !,"Job NOT Scheduled"
KILL DTOUT,DUOUT,DIR,DA,X,Y
SET STOP=""
QUIT
+4 IF Y'>START
WRITE !,"Stop Time must be greater than Start Time"
GOTO TRY
+5 DO DD^%DT
+6 SET ENDT=Y
+7 KILL DIR,DIE,DR,DA,X,Y
+8 SET DIE="^MPIF(984.8,"
SET DR="9///"_ENDT
SET DA=1
DO ^DIE
+9 KILL DIE,X,Y,DA,DR
+10 IF $DATA(DTOUT)!($DATA(DUOUT))
WRITE !,"Job NOT Scheduled"
KILL DTOUT,DUOUT,DIR,DA,X,Y
SET STOP=""
QUIT
+11 QUIT
+12 ;
GO ;ENTRY POINT
+1 IF '$DATA(ZTQUEUED)
LOCK +^XTMP("MPIF BATCH LOAD"):3
IF '$TEST
WRITE !,"JOB ALREADY RUNNING"
QUIT
+2 IF '$DATA(ZTQUEUED)
IF ('$DATA(^RGSITE(991.8,1,"CMOR")))
WRITE !,"CMOR Scores NOT Complete"
GOTO EXIT
+3 IF '$DATA(ZTQUEUED)
IF $DATA(^RGSITE(991.8,1,"CMOR"))
IF $PIECE($GET(^RGSITE(991.8,1,"CMOR")),"^",7)'="SN"
WRITE !,"CMOR Scores NOT Complete"
GOTO EXIT
+4 KILL STOP
+5 ;Check to see if job had STOPed-start where left off, start over or quit
+6 IF '$DATA(ZTQUEUED)
IF $PIECE($GET(^MPIF(984.8,1,0)),"^",6)'=""
DO AGAIN
+7 IF $DATA(STOP)
WRITE !,"Job NOT Started"
KILL STOP
GOTO EXIT
+8 IF '$DATA(ZTQUEUED)
DO BEG
+9 IF $DATA(STOP)
KILL STOP
GOTO EXIT
GO1 KILL ^TMP("HLS",$JOB)
+1 NEW MPIMORE,MPITOT
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 SET QUITIME=$PIECE(^MPIF(984.8,1,0),"^",10)
+4 IF '$DATA(ORDER)
SET ORDER=0
+5 ;
+6 KILL ^TMP("HLS",$JOB)
+7 SET MPICNT=$SELECT($PIECE(^MPIF(984.8,1,0),"^",9)>1:$PIECE(^MPIF(984.8,1,0),"^",9),1:1)
+8 IF +ORDER<1
SET ORDER=0
+9 DO WORK
+10 IF $DATA(^TMP("HLS",$JOB))
DO SEND
+11 DO STOP^RGHLLOG(0)
+12 KILL MPIIT,MPITOT,HLDT,HLDT1,MPICNT,MPIDNUM,MPIEROR,MPIMIDT,MPIMSH
+13 KILL MPIOUT,MPIQRYNM,MPISEQ,ORDER,QCNT,QUITIME,MPIMCNT,MPIMTX,ORDER,START
+14 KILL ENDT
+15 LOCK -^XTMP("MPIF BATCH LOAD")
+16 QUIT
WORK ;
+1 if $PIECE(^MPIF(984.8,1,0),"^",6)="STOP"
QUIT
+2 DO NOW^%DTC
+3 SET $PIECE(^MPIF(984.8,1,0),"^",2)=%
+4 IF %>QUITIME
QUIT
+5 SET MPIMCNT=""
SET MPIMTX=""
+6 DO HLRDF
DO LOOP
+7 QUIT
+8 ;
HLRDF ;
+1 SET (MPIOUT,MPIMCNT)=""
+2 SET HL("ECH")="^~\&"
+3 SET HL("FS")="|"
+4 DO INIT^HLFNC2("MPIF ICN-Q02 SERVER",.HL)
+5 IF $ORDER(HL(""))
SET ^TMP($JOB,"MPIF","ERR")=HL
+6 DO CREATE^HLTF(.MPIMCNT,.MPIMTX,.HLDT,.HLDT1)
+7 DO START^RGHLLOG()
+8 if $PIECE(^MPIF(984.8,1,0),"^",6)="STOP"
QUIT
+9 SET $PIECE(^MPIF(984.8,1,0),"^",7)=MPIMCNT
+10 SET $PIECE(^MPIF(984.8,1,0),"^",8)=MPIMTX
+11 QUIT
LOOP ;
+1 if $PIECE(^MPIF(984.8,1,0),"^",6)="STOP"
QUIT
+2 SET MPIDNUM=1
+3 DO MAKE
+4 QUIT
SEND ;ready to send
+1 SET $PIECE(^MPIF(984.8,1,0),"^",5)="GENERATE TAG"
+2 DO GENERATE^HLMA("MPIF ICN-Q02 SERVER","GB",1,.MPIMTX,.MPIEROR,.MPIMORE)
+3 IF +MPIEROR=0
SET ^TMP($JOB,"MPIF","ERR")=MPIEROR
+4 DO NOW^%DTC
+5 SET $PIECE(^MPIF(984.8,1,0),"^",3)=%
+6 KILL %,MPIMTX,MPIEROR,MPIMORE
+7 KILL ^TMP("HLS",$JOB)
+8 QUIT
MAKE ;
+1 FOR
SET ORDER=$ORDER(^DPT("ACMORS",ORDER))
if ORDER=""!($PIECE(^MPIF(984.8,1,0),"^",6)="STOP")
QUIT
Begin DoDot:1
+2 SET MPIIT=0
+3 FOR
SET MPIIT=$ORDER(^DPT("ACMORS",ORDER,MPIIT))
if MPIIT=""!($PIECE(^MPIF(984.8,1,0),"^",6)="STOP")
QUIT
Begin DoDot:2
+4 DO MAKE3
+5 DO NOW^%DTC
+6 IF %>QUITIME
SET $PIECE(^MPIF(984.8,1,0),"^",6)="STOP"
End DoDot:2
End DoDot:1
+7 QUIT
MAKE3 ;
+1 KILL MPIOUT
+2 if $PIECE(^MPIF(984.8,1,0),"^",6)="STOP"
QUIT
+3 SET $PIECE(^MPIF(984.8,1,0),"^",5)="LOOPING: "_MPIDNUM
+4 if $GET(MPIQRYNM)=""
SET MPIQRYNM="VTQ_PID_ICN_LOAD_1"
+5 DO VTQ1^MPIFVTQ(MPIIT,.MPIOUT,.HL,.MPIQRYNM)
+6 IF $PIECE(MPIOUT(0),"^",1)<0
IF $PIECE(MPIOUT(0),"^",2)="invalid DFN"!($PIECE(MPIOUT(0),"^",2)="no encoding characters")
Begin DoDot:1
+7 DO EXC^RGHLLOG(206,"DFN = "_MPIIT_" Problem with building VTQ was "_$PIECE(MPIOUT(0),"^",2),MPIIT)
QUIT
End DoDot:1
+8 ;I $P(MPIOUT(0),"^")<0,$P(MPIOUT(0),"^",2)="Missing Required Field(s)" D EXC^RGHLLOG(209,"DFN - "_MPIIT_" Missing Required Field(s)",MPIIT) Q
+9 if $PIECE(MPIOUT(0),"^")<0
QUIT
+10 ;call for HL7 header
+11 SET MPIMIDT=MPIMCNT_"-"_MPIDNUM
+12 DO MSH^HLFNC2(.HL,MPIMIDT,.MPIMSH)
+13 SET MPIOUT(1)=MPIMSH
+14 ;MESSAGE BUILT
+15 SET MPISEQ=0
+16 FOR
SET MPISEQ=$ORDER(MPIOUT(MPISEQ))
if MPISEQ'>0
QUIT
Begin DoDot:1
+17 SET ^TMP("HLS",$JOB,MPICNT)=MPIOUT(MPISEQ)
+18 SET MPICNT=MPICNT+1
End DoDot:1
+19 SET $PIECE(^MPIF(984.8,1,0),"^",11)=ORDER
+20 SET $PIECE(^MPIF(984.8,1,0),"^",9)=MPICNT
+21 SET $PIECE(^MPIF(984.8,1,0),"^",4)=MPIIT
+22 SET MPIDNUM=MPIDNUM+1
+23 IF MPIDNUM>100
Begin DoDot:1
+24 DO SEND
+25 SET (MPICNT,MPIDNUM)=1
+26 DO HLRDF
End DoDot:1
+27 QUIT
+28 ;
AGAIN ;job started before
+1 WRITE !,"Job was started before and has Stopped"
+2 KILL DIR,DR
+3 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Begin Where Left Off? "
SET DIR("?")="Y for yes to start where job left off, N for no"
+4 DO ^DIR
+5 IF Y=1
SET ORDER=$PIECE(^MPIF(984.8,1,0),"^",11)
SET $PIECE(^MPIF(984.8,1,0),"^",6)=""
GOTO END
+6 ;job started but used doesn't want to start where job left off
+7 WRITE !,"'E' - Exit or 'O' - Start over from the Beginning"
+8 KILL DIR,DR
+9 SET DIR(0)="S^E:EXIT;O:OVER"
SET DIR("?")="E for Exit, O to Start Over from the Beginning"
+10 SET DIR("A")="What would you like to do?"
+11 DO ^DIR
+12 if Y="E"
SET STOP=""
+13 if Y="O"
SET ORDER=0
SET $PIECE(^MPIF(984.8,1,0),"^",6)=""
END ;
+1 KILL DIR,Y,DR,X
+2 ; wants to start over or from where job left off if '$d(stop)
+3 QUIT
