MPIFEXT3 ;SFCIO/CMC-EXTENDED PDAT 3 - RPC ;26 JUN 01
;;1.0; MASTER PATIENT INDEX VISTA ;**20**;30 Apr 99
;
;Integration Agreements Utilized:
; ^DPT( - #2070
; $$GET1^DIQ(870,+$P(ARRAY("LINKS",SUBNUM),"^",6)_",",.02,"E") - #3573
; D GETS^DIQ(2,IEN_",","1*","E","MPIFA") - #3581
;
ALIAS(RET,IEN,RPC) ; get any Aliases for patient IEN
N ALIEN,RET2,MPIFA
I RPC=1 S TEXT="MPI("_IEN_",""ALIAS(ES)"")="
S ALIEN=0,RET2=""
D GETS^DIQ(2,IEN_",","1*","E","MPIFA")
;; MPIFA(2.01,"1,1,",.01,"E")=Funky K
F S ALIEN=$O(MPIFA(2.01,ALIEN)) Q:'ALIEN D
.I $G(MPIFA(2.01,ALIEN,.01,"E"))'="" S RET2=RET2_$G(MPIFA(2.01,ALIEN,.01,"E"))_"^"
I RET2=""!(RET2?."^") S RET2="NONE"
S RET(IEN,"ALIAS(ES)")=TEXT_""""_RET2_""""
Q
CMORCH(RET,DFN,RPC) ; get any CMOR Change Requests for this patient
K MPIFCCR
D CCRDAT^MPIFUTL(DFN,"MPIFCCR")
N REQ,FLD,TOT
S REQ=0,TOT=$G(MPIFCCR(0))
F S REQ=$O(MPIFCCR(REQ)) Q:REQ="" D
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REQ #"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"REQ #")=TEXT_""""_$G(MPIFCCR(REQ,.01))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REQ BY"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"REQ BY")=TEXT_""""_$G(MPIFCCR(REQ,.02))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""DT REQ"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"DT REQ")=TEXT_""""_$G(MPIFCCR(REQ,.03))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""PATIENT"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"PATIENT")=TEXT_""""_$G(MPIFCCR(REQ,.04))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REQ PHONE"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"REQ PHONE")=TEXT_""""_$G(MPIFCCR(REQ,.05))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""STATUS"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"STATUS")=TEXT_""""_$G(MPIFCCR(REQ,.06))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""SITE"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"SITE")=TEXT_""""_$G(MPIFCCR(REQ,.07))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""TYPE"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"TYPE")=TEXT_""""_$G(MPIFCCR(REQ,.08))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""CMOR AFTER APP"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"CMOR AFTER APP")=TEXT_""""_$G(MPIFCCR(REQ,.09))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REQ NAME"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"REQ NAME")=TEXT_""""_$G(MPIFCCR(REQ,1.01))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REQ REASON"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"REQ REASON")=TEXT_""""_$G(MPIFCCR(REQ,1.02))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""TYPE OF ACTION"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"TYPE OF ACTION")=TEXT_""""_$G(MPIFCCR(REQ,1.03))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REV BY"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"REV BY")=TEXT_""""_$G(MPIFCCR(REQ,2.01))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""DT REV"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"DT REV")=TEXT_""""_$G(MPIFCCR(REQ,2.02))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REV PHONE"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"REV PHONE")=TEXT_""""_$G(MPIFCCR(REQ,2.03))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REV BY"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"REV BY")=TEXT_""""_$G(MPIFCCR(REQ,3.01))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REV COMMENTS"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"REV COMMENTS")=TEXT_""""_$G(MPIFCCR(REQ,3.02))_""""
.I RPC=1 S TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""BLURB"")="
.S RET(DFN,"CMOR CHG REQ",REQ,"BLURB")=TEXT_""""_$G(MPIFCCR(REQ,999))_""""
K MPIFCCR
Q
TFLIST(RET,DFN,RPC) ;
; return the complete list of Treating Facilities for patient DFN
N ARRAY,TEXT,XX,STN,NM
S (STN,TEXT)="",XX=0
D GETTFS^MPIFEXT(DFN,.ARRAY)
I RPC=1 S TEXT="MPI("_DFN_",""TF LIST"","
S RET(DFN,"TF LIST",0)=TEXT_XX_")="
I +ARRAY<1 S RET(DFN,"TF LIST",0)=TEXT_XX_")="_"""NONE""" Q
F S STN=$O(ARRAY(STN)) Q:STN="" D
.S XX=XX+1
.S NM=$P($$NNT^XUAF4($$LKUP^XUAF4(STN)),"^")
.S RET(DFN,"TF LIST",XX)=TEXT_XX_")="_""""_NM_" ("_STN_")"""
S RET(DFN,"TF LIST",0)=$G(RET(DFN,"TF LIST",0))_XX
Q
SUBLST(RET,DFN,RPC) ;
; return the complete list of Subscribers for patient DFN
N INST,TERM,TERMDT,MPINODE,SUBNUM,SUB,XX,MPIFX
S XX=0,TEXT=""
S MPINODE=$$MPINODE^MPIFAPI(DFN)
S SUB=$P(MPINODE,"^",5)
I RPC=1 S TEXT="MPI("_DFN_",""SUB LIST"","
S RET(DFN,"SUB LIST",0)=TEXT_XX_")="
I SUB<1 S RET(DFN,"SUB LIST",0)=TEXT_XX_")="_"""NONE""" Q
D GET^HLSUB(SUB,0,"",.MPIFX)
I '$O(MPIFX("LINKS",0)) S RET(DFN,"SUB LIST",0)=TEXT_XX_")="_"""NONE""" Q
S SUBNUM=0
F S SUBNUM=$O(MPIFX("LINKS",SUBNUM)) Q:SUBNUM="" D
.S XX=XX+1
.S INST=$$GET1^DIQ(870,+$P(MPIFX("LINKS",SUBNUM),"^",6)_",",.02,"E")
.S TERM=$P(MPIFX("LINKS",SUBNUM),"^",10)
.S TERMDT=$$FMTE^XLFDT($E(TERM,1,12)) I TERMDT="" S TERMDT="None Found"
.S RET(DFN,"SUB LIST",XX)=TEXT_XX_")="_""""_INST_" Termination Date:"_TERMDT_""""
S RET(DFN,"SUB LIST",0)=$G(RET(DFN,"SUB LIST",0))_XX
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFEXT3 5092 printed Apr 09, 2024@21:14:05 Page 2
MPIFEXT3 ;SFCIO/CMC-EXTENDED PDAT 3 - RPC ;26 JUN 01
+1 ;;1.0; MASTER PATIENT INDEX VISTA ;**20**;30 Apr 99
+2 ;
+3 ;Integration Agreements Utilized:
+4 ; ^DPT( - #2070
+5 ; $$GET1^DIQ(870,+$P(ARRAY("LINKS",SUBNUM),"^",6)_",",.02,"E") - #3573
+6 ; D GETS^DIQ(2,IEN_",","1*","E","MPIFA") - #3581
+7 ;
ALIAS(RET,IEN,RPC) ; get any Aliases for patient IEN
+1 NEW ALIEN,RET2,MPIFA
+2 IF RPC=1
SET TEXT="MPI("_IEN_",""ALIAS(ES)"")="
+3 SET ALIEN=0
SET RET2=""
+4 DO GETS^DIQ(2,IEN_",","1*","E","MPIFA")
+5 ;; MPIFA(2.01,"1,1,",.01,"E")=Funky K
+6 FOR
SET ALIEN=$ORDER(MPIFA(2.01,ALIEN))
if 'ALIEN
QUIT
Begin DoDot:1
+7 IF $GET(MPIFA(2.01,ALIEN,.01,"E"))'=""
SET RET2=RET2_$GET(MPIFA(2.01,ALIEN,.01,"E"))_"^"
End DoDot:1
+8 IF RET2=""!(RET2?."^")
SET RET2="NONE"
+9 SET RET(IEN,"ALIAS(ES)")=TEXT_""""_RET2_""""
+10 QUIT
CMORCH(RET,DFN,RPC) ; get any CMOR Change Requests for this patient
+1 KILL MPIFCCR
+2 DO CCRDAT^MPIFUTL(DFN,"MPIFCCR")
+3 NEW REQ,FLD,TOT
+4 SET REQ=0
SET TOT=$GET(MPIFCCR(0))
+5 FOR
SET REQ=$ORDER(MPIFCCR(REQ))
if REQ=""
QUIT
Begin DoDot:1
+6 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REQ #"")="
+7 SET RET(DFN,"CMOR CHG REQ",REQ,"REQ #")=TEXT_""""_$GET(MPIFCCR(REQ,.01))_""""
+8 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REQ BY"")="
+9 SET RET(DFN,"CMOR CHG REQ",REQ,"REQ BY")=TEXT_""""_$GET(MPIFCCR(REQ,.02))_""""
+10 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""DT REQ"")="
+11 SET RET(DFN,"CMOR CHG REQ",REQ,"DT REQ")=TEXT_""""_$GET(MPIFCCR(REQ,.03))_""""
+12 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""PATIENT"")="
+13 SET RET(DFN,"CMOR CHG REQ",REQ,"PATIENT")=TEXT_""""_$GET(MPIFCCR(REQ,.04))_""""
+14 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REQ PHONE"")="
+15 SET RET(DFN,"CMOR CHG REQ",REQ,"REQ PHONE")=TEXT_""""_$GET(MPIFCCR(REQ,.05))_""""
+16 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""STATUS"")="
+17 SET RET(DFN,"CMOR CHG REQ",REQ,"STATUS")=TEXT_""""_$GET(MPIFCCR(REQ,.06))_""""
+18 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""SITE"")="
+19 SET RET(DFN,"CMOR CHG REQ",REQ,"SITE")=TEXT_""""_$GET(MPIFCCR(REQ,.07))_""""
+20 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""TYPE"")="
+21 SET RET(DFN,"CMOR CHG REQ",REQ,"TYPE")=TEXT_""""_$GET(MPIFCCR(REQ,.08))_""""
+22 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""CMOR AFTER APP"")="
+23 SET RET(DFN,"CMOR CHG REQ",REQ,"CMOR AFTER APP")=TEXT_""""_$GET(MPIFCCR(REQ,.09))_""""
+24 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REQ NAME"")="
+25 SET RET(DFN,"CMOR CHG REQ",REQ,"REQ NAME")=TEXT_""""_$GET(MPIFCCR(REQ,1.01))_""""
+26 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REQ REASON"")="
+27 SET RET(DFN,"CMOR CHG REQ",REQ,"REQ REASON")=TEXT_""""_$GET(MPIFCCR(REQ,1.02))_""""
+28 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""TYPE OF ACTION"")="
+29 SET RET(DFN,"CMOR CHG REQ",REQ,"TYPE OF ACTION")=TEXT_""""_$GET(MPIFCCR(REQ,1.03))_""""
+30 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REV BY"")="
+31 SET RET(DFN,"CMOR CHG REQ",REQ,"REV BY")=TEXT_""""_$GET(MPIFCCR(REQ,2.01))_""""
+32 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""DT REV"")="
+33 SET RET(DFN,"CMOR CHG REQ",REQ,"DT REV")=TEXT_""""_$GET(MPIFCCR(REQ,2.02))_""""
+34 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REV PHONE"")="
+35 SET RET(DFN,"CMOR CHG REQ",REQ,"REV PHONE")=TEXT_""""_$GET(MPIFCCR(REQ,2.03))_""""
+36 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REV BY"")="
+37 SET RET(DFN,"CMOR CHG REQ",REQ,"REV BY")=TEXT_""""_$GET(MPIFCCR(REQ,3.01))_""""
+38 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""REV COMMENTS"")="
+39 SET RET(DFN,"CMOR CHG REQ",REQ,"REV COMMENTS")=TEXT_""""_$GET(MPIFCCR(REQ,3.02))_""""
+40 IF RPC=1
SET TEXT="MPI("_DFN_",""CMOR CHG REQ"","_REQ_",""BLURB"")="
+41 SET RET(DFN,"CMOR CHG REQ",REQ,"BLURB")=TEXT_""""_$GET(MPIFCCR(REQ,999))_""""
End DoDot:1
+42 KILL MPIFCCR
+43 QUIT
TFLIST(RET,DFN,RPC) ;
+1 ; return the complete list of Treating Facilities for patient DFN
+2 NEW ARRAY,TEXT,XX,STN,NM
+3 SET (STN,TEXT)=""
SET XX=0
+4 DO GETTFS^MPIFEXT(DFN,.ARRAY)
+5 IF RPC=1
SET TEXT="MPI("_DFN_",""TF LIST"","
+6 SET RET(DFN,"TF LIST",0)=TEXT_XX_")="
+7 IF +ARRAY<1
SET RET(DFN,"TF LIST",0)=TEXT_XX_")="_"""NONE"""
QUIT
+8 FOR
SET STN=$ORDER(ARRAY(STN))
if STN=""
QUIT
Begin DoDot:1
+9 SET XX=XX+1
+10 SET NM=$PIECE($$NNT^XUAF4($$LKUP^XUAF4(STN)),"^")
+11 SET RET(DFN,"TF LIST",XX)=TEXT_XX_")="_""""_NM_" ("_STN_")"""
End DoDot:1
+12 SET RET(DFN,"TF LIST",0)=$GET(RET(DFN,"TF LIST",0))_XX
+13 QUIT
SUBLST(RET,DFN,RPC) ;
+1 ; return the complete list of Subscribers for patient DFN
+2 NEW INST,TERM,TERMDT,MPINODE,SUBNUM,SUB,XX,MPIFX
+3 SET XX=0
SET TEXT=""
+4 SET MPINODE=$$MPINODE^MPIFAPI(DFN)
+5 SET SUB=$PIECE(MPINODE,"^",5)
+6 IF RPC=1
SET TEXT="MPI("_DFN_",""SUB LIST"","
+7 SET RET(DFN,"SUB LIST",0)=TEXT_XX_")="
+8 IF SUB<1
SET RET(DFN,"SUB LIST",0)=TEXT_XX_")="_"""NONE"""
QUIT
+9 DO GET^HLSUB(SUB,0,"",.MPIFX)
+10 IF '$ORDER(MPIFX("LINKS",0))
SET RET(DFN,"SUB LIST",0)=TEXT_XX_")="_"""NONE"""
QUIT
+11 SET SUBNUM=0
+12 FOR
SET SUBNUM=$ORDER(MPIFX("LINKS",SUBNUM))
if SUBNUM=""
QUIT
Begin DoDot:1
+13 SET XX=XX+1
+14 SET INST=$$GET1^DIQ(870,+$PIECE(MPIFX("LINKS",SUBNUM),"^",6)_",",.02,"E")
+15 SET TERM=$PIECE(MPIFX("LINKS",SUBNUM),"^",10)
+16 SET TERMDT=$$FMTE^XLFDT($EXTRACT(TERM,1,12))
IF TERMDT=""
SET TERMDT="None Found"
+17 SET RET(DFN,"SUB LIST",XX)=TEXT_XX_")="_""""_INST_" Termination Date:"_TERMDT_""""
End DoDot:1
+18 SET RET(DFN,"SUB LIST",0)=$GET(RET(DFN,"SUB LIST",0))_XX
+19 QUIT
