source: WorldVistAEHR/trunk/r/MASTER_PATIENT_INDEX_VISTA-MPIF/MPIFUTL.m@ 1714

Last change on this file since 1714 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1MPIFUTL ;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 ;
8TYPE ;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
12MAIL() ;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
19CHK1(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 ;
30CHK2(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 ;
38CCRDAT(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
Note: See TracBrowser for help on using the repository browser.