| 1 | MPIFUTL ;BHM/RGY-CMOR Utilities ;FEB 26, 1998
|
|---|
| 2 | ;;1.0; MASTER PATIENT INDEX VISTA ;**11**;30 Apr 99
|
|---|
| 3 | ;
|
|---|
| 4 | ; Integration Agreements Utilized:
|
|---|
| 5 | ;
|
|---|
| 6 | ; ^DGCN(391.91 IA #2751
|
|---|
| 7 | ;
|
|---|
| 8 | TYPE ;Set type of CMOR request change
|
|---|
| 9 | NEW DIE,DR,DA
|
|---|
| 10 | S DIE="^RGSITE(991.8,",DR="[MPIF SITE PARAMETERS]",DA=1 D ^DIE
|
|---|
| 11 | Q
|
|---|
| 12 | MAIL() ;Get mailgroup for new requests
|
|---|
| 13 | N IEN,MGROUP
|
|---|
| 14 | S IEN=$P($G(^RGSITE(991.8,1,0)),"^",3)
|
|---|
| 15 | Q:IEN="" "-1^No Mailgroup defined"
|
|---|
| 16 | S MGROUP=$$EXTERNAL^DILFD(991.8,.03,,IEN)
|
|---|
| 17 | Q:MGROUP="" "-1^No Mailgroup defined"
|
|---|
| 18 | Q MGROUP
|
|---|
| 19 | CHK1(D0) ;Check out a new request for patient data
|
|---|
| 20 | NEW PAT,X,OPEN
|
|---|
| 21 | S OPEN=0
|
|---|
| 22 | S PAT=+$P($G(^MPIF(984.9,D0,0)),"^",4)
|
|---|
| 23 | I PAT=0 W !!,"*** Patient not defined for this request ***" Q 1
|
|---|
| 24 | I '$$PAT^MPIFNQ(PAT) W !!,"*** Patient has not been assigned a CMOR Site ***",! Q 1
|
|---|
| 25 | F X=0:0 S X=$O(^MPIF(984.9,"C",PAT,X)) Q:'X D:X'=D0 Q:OPEN
|
|---|
| 26 | .I $P(^MPIF(984.9,X,0),"^",6)'=4,$P(^(0),"^",6)'=5 S OPEN=X
|
|---|
| 27 | I OPEN W !,"*** Patient already has an open request (",$P(^MPIF(984.9,OPEN,0),"^"),") ***" Q 1
|
|---|
| 28 | Q 0
|
|---|
| 29 | ;
|
|---|
| 30 | CHK2(D0) ;Check out a new requeste for site
|
|---|
| 31 | I $P(^MPIF(984.9,D0,0),"^",7)="" W !!,"*** You must enter a site to send this request to ***" Q 1
|
|---|
| 32 | I $P(^MPIF(984.9,D0,0),"^",7)=+$$SITE^VASITE() W !!,"*** You cannot send a request to your own site ***" Q 1
|
|---|
| 33 | N SITE,PT
|
|---|
| 34 | S SITE=$P(^MPIF(984.9,D0,0),"^",7),PT=$P(^MPIF(984.9,D0,0),"^",4)
|
|---|
| 35 | I '$D(^DGCN(391.91,"APAT",PT,SITE)) W !!,"*** You cannot send a request to a site that isn't a treating facility for this patient ***" Q 1
|
|---|
| 36 | Q 0
|
|---|
| 37 | ;
|
|---|
| 38 | CCRDAT(PAT,ARR) ; API to return all known CMOR Change Request Information
|
|---|
| 39 | ; PAT - DFN of patient in Patient file (#2)
|
|---|
| 40 | ; ARR - Array to return information. First subscript will be request number, next will be the field number. field 9999 will be the display text
|
|---|
| 41 | ; ARR(0) will equal -1 eror message if there was a problem or no data found. If data is found, ARR(0) will equal the number of requests found.
|
|---|
| 42 | ;
|
|---|
| 43 | I '$D(PAT)!('$D(ARR)) Q
|
|---|
| 44 | I $O(^MPIF(984.9,"C",PAT,""))="" S @ARR@(0)="-1^No Requests on File" Q
|
|---|
| 45 | N SITE,IEN,MPIFA,CNT,IENT,TEXT,REQN
|
|---|
| 46 | S IEN=0,CNT=0
|
|---|
| 47 | F S IEN=$O(^MPIF(984.9,"C",PAT,IEN)) Q:IEN="" D
|
|---|
| 48 | .I '$D(^MPIF(984.9,IEN)) Q
|
|---|
| 49 | .D GETS^DIQ(984.9,IEN,".01;.02;.03;.04;.05;.06;.07;.08;.09;1.01;1.02;1.03;2.01;2.02;2.03;3.01;3.02","","MPIFA")
|
|---|
| 50 | .S IENT=IEN_","
|
|---|
| 51 | .Q:MPIFA(984.9,IENT,.01)=""
|
|---|
| 52 | .S CNT=CNT+1
|
|---|
| 53 | .S REQN=MPIFA(984.9,IENT,.01)
|
|---|
| 54 | .M @ARR@(REQN)=MPIFA(984.9,IENT)
|
|---|
| 55 | .N SIEN S SIEN=$P(^MPIF(984.9,IEN,0),"^",7)
|
|---|
| 56 | .N STN I SIEN'="" S STN=$P($$NS^XUAF4(SIEN),"^",2)
|
|---|
| 57 | .N SIEN2 S SIEN2=$P(^MPIF(984.9,IEN,0),"^",9)
|
|---|
| 58 | .N STN2 I SIEN2'="" S STN2=$P($$NS^XUAF4(SIEN2),"^",2)
|
|---|
| 59 | .S TEXT=@ARR@(REQN,1.03)_" "_@ARR@(REQN,.07)_" (#"_$G(STN)_") to change CMOR to "_@ARR@(REQN,.09)_" (#"_$G(STN2)_")."
|
|---|
| 60 | .S @ARR@(REQN,999)=TEXT
|
|---|
| 61 | S @ARR@(0)=CNT
|
|---|
| 62 | Q
|
|---|
