- MPIFSEED ;BP/CMC-SEEDING OF A31s TO MPI AND SUB CLEANUP ;FEB 5, 2002
- ;;1.0; MASTER PATIENT INDEX VISTA ;**22,24,27**;30 Apr 99
- ;
- ;CHANGING SEEDING TO SEND X NUMBER OF MESSAGES EACH TIME BACK GROUND
- ; JOB XXX RUNS UNTIL ALL ARE SENT. KEEPING TRACK OF WHERE WE ARE AT
- ; FOR THE NEXT JOB TO START AT
- ; SEND E-MAIL WHEN FINISH EACH GROUP AND A SITE COMPLETES SEEDING
- ; ALL PATIENTS.
- ;
- ; Intregration Agreement Utilized:
- ;
- ; ^DPT("AICNL", ^DPT("AICN", ^DPT("AMPIMIS", ^DPT("ASCN2" - #2070
- ; ^DPT( - #2070
- ;
- ; $O through Patient file (#2) Sending A31 message for any patients
- ; with an active National ICN.
- ;
- EN ;
- I $D(^XTMP("MPIF_SEEDING"))&('$D(^XTMP("MPIF_SEEDING","STOPPED"))) Q
- ; ^ Seeding job is already running
- D START
- Q
- QUEUE ;
- I $D(^XTMP("MPIF_SEEDING"))&('$D(^XTMP("MPIF_SEEDING","STOPPED"))) Q
- ; ^ Seeding job is already running
- S ZTRTN="START^MPIFSEED",ZTDESC="A31 SEEDING FOR SITE"
- D NOW^%DTC
- S ZTIO="",ZTDTH=%
- I $D(DUZ) S ZTSAVE("DUZ")=DUZ
- D ^%ZTLOAD
- D HOME^%ZIS K IO("Q")
- K ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,%
- Q
- ;
- START N ICN,DFN,SSN,CNT,XICN,SITE,ARRAY,ARR,SUB,A31,A31E,NODE,IEN,STOP,MANY
- N OICN,OA31E,OCNT,NODE,STICN
- I $D(ZTQUEUED) S ZTREQ="@"
- I $D(^XTMP("MPIF_SEEDING"))&('$D(^XTMP("MPIF_SEEDING","STOPPED"))) Q
- S (DFN,CNT,XICN,A31E)=0,ARR="ARRAY"
- D NOW^%DTC
- S ^XTMP("MPIF_SEEDING",0)=%+10_"^"_%_"^Seeding MPI w/A31s"
- S ^XTMP("MPIF_SEEDING","STARTED")=%
- I '$D(^DPT("AICN")) S ^XTMP("MPIF_SEEDING","STOPPED")=% Q
- ; ^ No ICNs
- ;GET LAST ICN COMPLETED
- S IEN=$O(^MPIF(984.8,"B","ONE","")),NODE=$G(^MPIF(984.8,IEN,0))
- I $P(NODE,"^",5)'="" S ^XTMP("MPIF_SEEDING","STOPPED")=% Q
- ; ^ SEEDING FINISHED
- S OICN=+$P(NODE,"^",8),OA31E=+$P(NODE,"^",7),OCNT=+$P(NODE,"^",6)
- S ICN=$P(NODE,"^",11),SITE=$P($$SITE^VASITE(),"^",3),STOP=0
- S STICN=+$P(NODE,"^",4) I STICN=0 S STICN=$O(^DPT("AICN","A"),-1)
- S MANY=$P(NODE,"^",9)
- I +MANY<1 S ^XTMP("MPIF_SEEDING","STOPPED")=% Q
- F S ICN=$O(^DPT("AICN",ICN)) Q:ICN=""!(STOP) D
- .I ICN=STICN!(ICN>STICN) S STOP=1
- .Q:$E(ICN,1,3)=SITE
- .; ^LOCAL ICN
- .S CNT=CNT+1
- .I '(CNT#10000) W:$E(IOST)="C" !,ICN S ^XTMP("MPIF_SEEDING","LAST")="CNT="_CNT_"^ICN="_ICN_"^SENT="_XICN
- .S DFN=$O(^DPT("AICN",ICN,""))
- .Q:+DFN<1
- .Q:'$D(^DPT(DFN,"MPI"))
- .I $P($G(^DPT(DFN,"MPI")),"^")=ICN S A31=$$A31^MPIFA31B(DFN) S:A31>0 XICN=XICN+1 S:+A31<1 ^XTMP("MPIF_SEEDING","A31 ERR",DFN)=A31,A31E=A31E+1
- .; ^ generate A31 message to MPI
- .I XICN=MANY S STOP=1,$P(NODE,"^",11)=ICN
- DONE S ^XTMP("MPIF_SEEDING","TOTAL","PROCESSED")=CNT,$P(NODE,"^",6)=CNT+OCNT
- S ^XTMP("MPIF_SEEDING","TOTAL","A31 SENT")=XICN,$P(NODE,"^",8)=XICN+OICN
- S ^XTMP("MPIF_SEEDING","TOTAL","A31 ERR")=A31E,$P(NODE,"^",7)=A31E+OA31E
- D NOW^%DTC
- S ^XTMP("MPIF_SEEDING","STOPPED")=%
- K %
- I ICN=""!(ICN=STICN)!(ICN>STICN) S $P(NODE,"^",5)="SEEDING COMPLETED" D MAIL("D")
- S ^MPIF(984.8,IEN,0)=NODE
- I $P(NODE,"^",5)="" D MAIL("C")
- Q
- ;
- MAIL(STAT) ;
- ;send bulletin that seeding round is complete or seeding has
- ;been completely finished
- ; STAT=
- ;"D" - completely finished
- ;"C" - round finished
- ;
- N MPIF,NODE,IEN,XMDUZ,XMSUB,XMY,XMTEXT,MSG
- S IEN=$O(^MPIF(984.8,"B","ONE",""))
- S NODE=$G(^MPIF(984.8,IEN,0))
- I STAT="D" S MSG="Seeding has been completed at site "_$P($$SITE^VASITE(),"^",2)_" (_"_$P($$SITE^VASITE(),"^",3)_")"
- I STAT="C" S MSG="Round of seeding has been completed at site "_$P($$SITE^VASITE(),"^",2)_" (_"_$P($$SITE^VASITE(),"^",3)_")"
- S MPIF(1,1)=MSG
- S MPIF(1,2)=""
- S MPIF(1,3)="Site stats for seeding (total to date): "
- S MPIF(1,4)=" AICN x-refs Processed: "_$P(NODE,"^",6)
- S MPIF(1,5)=" A31s Sent: "_$P(NODE,"^",8)
- S MPIF(1,6)=" A31 Errors: "_$P(NODE,"^",7)
- S XMDUZ="MPIF VISTA PACKAGE"
- S XMSUB="Seeding msg "_$P($$SITE^VASITE(),"^",2)_" ("_$P($$SITE^VASITE(),"^",3)_")"
- S XMY("G.CIRN DEV@DOMAIN.EXT")="",XMTEXT="MPIF(1,"
- D ^XMD
- Q
- ;
- SET(RETURN,NUMBER) ;
- ;
- N IEN,DIE,DA,DR
- S IEN=$O(^MPIF(984.8,"B","ONE","")),RETURN=0
- Q:IEN<1
- S DIE="^MPIF(984.8,",DA=IEN,DR="8////^S X=NUMBER"
- D ^DIE
- S NODE=$G(^MPIF(984.8,IEN,0))
- I $P(NODE,"^",9)=NUMBER S RETURN=1
- Q
- ;
- STATS(RETURN) ;
- ;
- N IEN,CNT,TICN,LAST,LONE,SITE
- S SITE=$P($$SITE^VASITE(),"^",3),CNT=0
- S IEN=$O(^MPIF(984.8,"B","ONE","")),RETURN=0
- Q:IEN<1
- S NODE=$G(^MPIF(984.8,IEN,0)),RETURN=1
- I $P(NODE,"^",5)'="" S RETURN(1)=NODE Q
- ;^ QUIT IF COMPLETED SEEDING ALREADY
- S LAST=$P(NODE,"^",11) ;LAST ICN PROCESSED
- I +LAST<1 S LAST=0
- S LONE=$P(NODE,"^",4) ;LAST ICN TO BE PROCESSED
- F S LAST=$O(^DPT("AICN",LAST)) Q:LAST>LONE S CNT=CNT+1
- K DIC
- N X,Y,BK,SCH
- S DIC="^DIC(19,",X="MPIF SEEDING TASK" D ^DIC K DIC S BK=+Y
- I BK<0 S RETURN(2)="MPIF SEEDING TASK doesn't exist in OPTION file"
- I BK>0 S DIC="^DIC(19.2,",X="MPIF SEEDING TASK" D ^DIC K DIC S SCH=+Y
- I SCH<0 S RETURN(2)="MPIF SEEDING TASK isn't scheduled to run"
- I SCH>0 S SCH=$$GET1^DIQ(19.2,SCH_",",2),RETURN(2)="MPIF SEEDING TASK is scheduled to run at "_$$FMTE^XLFDT(SCH)
- S RETURN(1)=NODE,RETURN(3)=CNT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFSEED 5074 printed Feb 18, 2025@23:38 Page 2
- MPIFSEED ;BP/CMC-SEEDING OF A31s TO MPI AND SUB CLEANUP ;FEB 5, 2002
- +1 ;;1.0; MASTER PATIENT INDEX VISTA ;**22,24,27**;30 Apr 99
- +2 ;
- +3 ;CHANGING SEEDING TO SEND X NUMBER OF MESSAGES EACH TIME BACK GROUND
- +4 ; JOB XXX RUNS UNTIL ALL ARE SENT. KEEPING TRACK OF WHERE WE ARE AT
- +5 ; FOR THE NEXT JOB TO START AT
- +6 ; SEND E-MAIL WHEN FINISH EACH GROUP AND A SITE COMPLETES SEEDING
- +7 ; ALL PATIENTS.
- +8 ;
- +9 ; Intregration Agreement Utilized:
- +10 ;
- +11 ; ^DPT("AICNL", ^DPT("AICN", ^DPT("AMPIMIS", ^DPT("ASCN2" - #2070
- +12 ; ^DPT( - #2070
- +13 ;
- +14 ; $O through Patient file (#2) Sending A31 message for any patients
- +15 ; with an active National ICN.
- +16 ;
- EN ;
- +1 IF $DATA(^XTMP("MPIF_SEEDING"))&('$DATA(^XTMP("MPIF_SEEDING","STOPPED")))
- QUIT
- +2 ; ^ Seeding job is already running
- +3 DO START
- +4 QUIT
- QUEUE ;
- +1 IF $DATA(^XTMP("MPIF_SEEDING"))&('$DATA(^XTMP("MPIF_SEEDING","STOPPED")))
- QUIT
- +2 ; ^ Seeding job is already running
- +3 SET ZTRTN="START^MPIFSEED"
- SET ZTDESC="A31 SEEDING FOR SITE"
- +4 DO NOW^%DTC
- +5 SET ZTIO=""
- SET ZTDTH=%
- +6 IF $DATA(DUZ)
- SET ZTSAVE("DUZ")=DUZ
- +7 DO ^%ZTLOAD
- +8 DO HOME^%ZIS
- KILL IO("Q")
- +9 KILL ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,%
- +10 QUIT
- +11 ;
- START NEW ICN,DFN,SSN,CNT,XICN,SITE,ARRAY,ARR,SUB,A31,A31E,NODE,IEN,STOP,MANY
- +1 NEW OICN,OA31E,OCNT,NODE,STICN
- +2 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +3 IF $DATA(^XTMP("MPIF_SEEDING"))&('$DATA(^XTMP("MPIF_SEEDING","STOPPED")))
- QUIT
- +4 SET (DFN,CNT,XICN,A31E)=0
- SET ARR="ARRAY"
- +5 DO NOW^%DTC
- +6 SET ^XTMP("MPIF_SEEDING",0)=%+10_"^"_%_"^Seeding MPI w/A31s"
- +7 SET ^XTMP("MPIF_SEEDING","STARTED")=%
- +8 IF '$DATA(^DPT("AICN"))
- SET ^XTMP("MPIF_SEEDING","STOPPED")=%
- QUIT
- +9 ; ^ No ICNs
- +10 ;GET LAST ICN COMPLETED
- +11 SET IEN=$ORDER(^MPIF(984.8,"B","ONE",""))
- SET NODE=$GET(^MPIF(984.8,IEN,0))
- +12 IF $PIECE(NODE,"^",5)'=""
- SET ^XTMP("MPIF_SEEDING","STOPPED")=%
- QUIT
- +13 ; ^ SEEDING FINISHED
- +14 SET OICN=+$PIECE(NODE,"^",8)
- SET OA31E=+$PIECE(NODE,"^",7)
- SET OCNT=+$PIECE(NODE,"^",6)
- +15 SET ICN=$PIECE(NODE,"^",11)
- SET SITE=$PIECE($$SITE^VASITE(),"^",3)
- SET STOP=0
- +16 SET STICN=+$PIECE(NODE,"^",4)
- IF STICN=0
- SET STICN=$ORDER(^DPT("AICN","A"),-1)
- +17 SET MANY=$PIECE(NODE,"^",9)
- +18 IF +MANY<1
- SET ^XTMP("MPIF_SEEDING","STOPPED")=%
- QUIT
- +19 FOR
- SET ICN=$ORDER(^DPT("AICN",ICN))
- if ICN=""!(STOP)
- QUIT
- Begin DoDot:1
- +20 IF ICN=STICN!(ICN>STICN)
- SET STOP=1
- +21 if $EXTRACT(ICN,1,3)=SITE
- QUIT
- +22 ; ^LOCAL ICN
- +23 SET CNT=CNT+1
- +24 IF '(CNT#10000)
- if $EXTRACT(IOST)="C"
- WRITE !,ICN
- SET ^XTMP("MPIF_SEEDING","LAST")="CNT="_CNT_"^ICN="_ICN_"^SENT="_XICN
- +25 SET DFN=$ORDER(^DPT("AICN",ICN,""))
- +26 if +DFN<1
- QUIT
- +27 if '$DATA(^DPT(DFN,"MPI"))
- QUIT
- +28 IF $PIECE($GET(^DPT(DFN,"MPI")),"^")=ICN
- SET A31=$$A31^MPIFA31B(DFN)
- if A31>0
- SET XICN=XICN+1
- if +A31<1
- SET ^XTMP("MPIF_SEEDING","A31 ERR",DFN)=A31
- SET A31E=A31E+1
- +29 ; ^ generate A31 message to MPI
- +30 IF XICN=MANY
- SET STOP=1
- SET $PIECE(NODE,"^",11)=ICN
- End DoDot:1
- DONE SET ^XTMP("MPIF_SEEDING","TOTAL","PROCESSED")=CNT
- SET $PIECE(NODE,"^",6)=CNT+OCNT
- +1 SET ^XTMP("MPIF_SEEDING","TOTAL","A31 SENT")=XICN
- SET $PIECE(NODE,"^",8)=XICN+OICN
- +2 SET ^XTMP("MPIF_SEEDING","TOTAL","A31 ERR")=A31E
- SET $PIECE(NODE,"^",7)=A31E+OA31E
- +3 DO NOW^%DTC
- +4 SET ^XTMP("MPIF_SEEDING","STOPPED")=%
- +5 KILL %
- +6 IF ICN=""!(ICN=STICN)!(ICN>STICN)
- SET $PIECE(NODE,"^",5)="SEEDING COMPLETED"
- DO MAIL("D")
- +7 SET ^MPIF(984.8,IEN,0)=NODE
- +8 IF $PIECE(NODE,"^",5)=""
- DO MAIL("C")
- +9 QUIT
- +10 ;
- MAIL(STAT) ;
- +1 ;send bulletin that seeding round is complete or seeding has
- +2 ;been completely finished
- +3 ; STAT=
- +4 ;"D" - completely finished
- +5 ;"C" - round finished
- +6 ;
- +7 NEW MPIF,NODE,IEN,XMDUZ,XMSUB,XMY,XMTEXT,MSG
- +8 SET IEN=$ORDER(^MPIF(984.8,"B","ONE",""))
- +9 SET NODE=$GET(^MPIF(984.8,IEN,0))
- +10 IF STAT="D"
- SET MSG="Seeding has been completed at site "_$PIECE($$SITE^VASITE(),"^",2)_" (_"_$PIECE($$SITE^VASITE(),"^",3)_")"
- +11 IF STAT="C"
- SET MSG="Round of seeding has been completed at site "_$PIECE($$SITE^VASITE(),"^",2)_" (_"_$PIECE($$SITE^VASITE(),"^",3)_")"
- +12 SET MPIF(1,1)=MSG
- +13 SET MPIF(1,2)=""
- +14 SET MPIF(1,3)="Site stats for seeding (total to date): "
- +15 SET MPIF(1,4)=" AICN x-refs Processed: "_$PIECE(NODE,"^",6)
- +16 SET MPIF(1,5)=" A31s Sent: "_$PIECE(NODE,"^",8)
- +17 SET MPIF(1,6)=" A31 Errors: "_$PIECE(NODE,"^",7)
- +18 SET XMDUZ="MPIF VISTA PACKAGE"
- +19 SET XMSUB="Seeding msg "_$PIECE($$SITE^VASITE(),"^",2)_" ("_$PIECE($$SITE^VASITE(),"^",3)_")"
- +20 SET XMY("G.CIRN DEV@DOMAIN.EXT")=""
- SET XMTEXT="MPIF(1,"
- +21 DO ^XMD
- +22 QUIT
- +23 ;
- SET(RETURN,NUMBER) ;
- +1 ;
- +2 NEW IEN,DIE,DA,DR
- +3 SET IEN=$ORDER(^MPIF(984.8,"B","ONE",""))
- SET RETURN=0
- +4 if IEN<1
- QUIT
- +5 SET DIE="^MPIF(984.8,"
- SET DA=IEN
- SET DR="8////^S X=NUMBER"
- +6 DO ^DIE
- +7 SET NODE=$GET(^MPIF(984.8,IEN,0))
- +8 IF $PIECE(NODE,"^",9)=NUMBER
- SET RETURN=1
- +9 QUIT
- +10 ;
- STATS(RETURN) ;
- +1 ;
- +2 NEW IEN,CNT,TICN,LAST,LONE,SITE
- +3 SET SITE=$PIECE($$SITE^VASITE(),"^",3)
- SET CNT=0
- +4 SET IEN=$ORDER(^MPIF(984.8,"B","ONE",""))
- SET RETURN=0
- +5 if IEN<1
- QUIT
- +6 SET NODE=$GET(^MPIF(984.8,IEN,0))
- SET RETURN=1
- +7 IF $PIECE(NODE,"^",5)'=""
- SET RETURN(1)=NODE
- QUIT
- +8 ;^ QUIT IF COMPLETED SEEDING ALREADY
- +9 ;LAST ICN PROCESSED
- SET LAST=$PIECE(NODE,"^",11)
- +10 IF +LAST<1
- SET LAST=0
- +11 ;LAST ICN TO BE PROCESSED
- SET LONE=$PIECE(NODE,"^",4)
- +12 FOR
- SET LAST=$ORDER(^DPT("AICN",LAST))
- if LAST>LONE
- QUIT
- SET CNT=CNT+1
- +13 KILL DIC
- +14 NEW X,Y,BK,SCH
- +15 SET DIC="^DIC(19,"
- SET X="MPIF SEEDING TASK"
- DO ^DIC
- KILL DIC
- SET BK=+Y
- +16 IF BK<0
- SET RETURN(2)="MPIF SEEDING TASK doesn't exist in OPTION file"
- +17 IF BK>0
- SET DIC="^DIC(19.2,"
- SET X="MPIF SEEDING TASK"
- DO ^DIC
- KILL DIC
- SET SCH=+Y
- +18 IF SCH<0
- SET RETURN(2)="MPIF SEEDING TASK isn't scheduled to run"
- +19 IF SCH>0
- SET SCH=$$GET1^DIQ(19.2,SCH_",",2)
- SET RETURN(2)="MPIF SEEDING TASK is scheduled to run at "_$$FMTE^XLFDT(SCH)
- +20 SET RETURN(1)=NODE
- SET RETURN(3)=CNT
- +21 QUIT