source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMOBJX.m@ 1704

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1PXRMOBJX ;SLC/AGP,JVS - CLINICAL REMINDERS ;5/15/03 14:15
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 Q
4 ;
5STATUS(DFN,ARRAY,MISSING) ;Evaluate The status of the Referral
6 ;
7 N STOP,ZTSK,CNT,GEC1,GEC2,GEC3,GECF,SOURCE
8 S STOP=0,CNT=0,ARRAY=""
9 ;
10 ;Returned
11 ;ARRAY as an array of information
12 ;
13 N HFDA,STOP
14 D ACOPYDEL^PXRMGECK
15 ;
16 ;GET IEN FOR DATA SOURCES FOR GEC
17 I $D(^PX(839.7,"B","GEC1")) S GEC1=$O(^PX(839.7,"B","GEC1",""))
18 I $D(^PX(839.7,"B","GEC2")) S GEC2=$O(^PX(839.7,"B","GEC2",""))
19 I $D(^PX(839.7,"B","GEC3")) S GEC3=$O(^PX(839.7,"B","GEC3",""))
20 I $D(^PX(839.7,"B","GECF")) S GECF=$O(^PX(839.7,"B","GECF",""))
21 ;
22 S STOP=0
23 S HFDA="" F S HFDA=$O(^AUPNVHF("C",DFN,HFDA)) Q:HFDA="" Q:STOP=1 D
24 .I $D(^AUPNVHF(HFDA,12)) D
25 ..I $P($G(^AUPNVHF(HFDA,12)),"^",1)>0 D
26 ...S SOURCE=$P($G(^AUPNVHF(HFDA,812)),"^",3)
27 ...Q:SOURCE=""
28 ...I (SOURCE=$G(GEC1))!(SOURCE=$G(GEC2))!(SOURCE=$G(GEC3))!(SOURCE=$G(GECF)) D
29 ....S STOP=1
30 ;
31 S (MISSING)=""
32 I '$D(^PXRMD(801.5,"B",DFN))&(STOP=0) D
33 .S ARRAY($$UP,1)="No GEC Referral on record."
34 I '$D(^PXRMD(801.5,"B",DFN))&(STOP=1) D
35 .S ARRAY($$UP,1)="No GEC Referral in progress."
36 Q:'$D(^PXRMD(801.5,"B",DFN))
37 ;
38 ;
39 ; A. look for missing dialog
40 S:'$D(^PXRMD(801.5,"AD",DFN,"GEC1")) MISSING=MISSING_1_"^"
41 S:'$D(^PXRMD(801.5,"AD",DFN,"GEC2")) MISSING=MISSING_2_"^"
42 S:'$D(^PXRMD(801.5,"AD",DFN,"GEC3")) MISSING=MISSING_3_"^"
43 ;S:'$D(^PXRMD(801.5,"AD",DFN,"GECF")) MISSING=MISSING_4
44 ; a. if none missing then set message
45 ; b. if missing then create message
46 I MISSING'=""!(MISSING="") D
47 .S ARRAY($$UP,1)="The following Dialog(s) are Complete:"
48 .S:MISSING'[1 ARRAY($$UP,1)=$P($T(T+7),";",3) D
49 ..I +$$TIUSTAT^PXRMGECK(DFN,"GEC1") D
50 ...S ARRAY($$UP,1)=" Note Status: "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC1"),":",2)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC1"),":",3)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC1"),":",4)
51 .S:MISSING'[2 ARRAY($$UP,1)=$P($T(T+8),";",3) D
52 ..I +$$TIUSTAT^PXRMGECK(DFN,"GEC2") D
53 ...S ARRAY($$UP,1)=" Note Status: "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC2"),":",2)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC2"),":",3)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC2"),":",4)
54 .S:MISSING'[3 ARRAY($$UP,1)=$P($T(T+9),";",3) D
55 ..I +$$TIUSTAT^PXRMGECK(DFN,"GEC3") D
56 ...S ARRAY($$UP,1)=" Note Status: "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC3"),":",2)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC3"),":",3)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC3"),":",4)
57 .;S:MISSING'[4 ARRAY($$UP,1)=$P($T(T+10),";",3) D
58 .;.I +$$TIUSTAT^PXRMGECK(DFN,"GECF") D
59 .;..S ARRAY($$UP,1)=" Note Status: "_$P($$TIUSTAT^PXRMGECK(DFN,"GECF"),":",2)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GECF"),":",3)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GECF"),":",4)
60 .I MISSING'="" S ARRAY($$UP,2)=$P($T(T+11),";",3)
61 .S:MISSING[1 ARRAY($$UP,2)=$P($T(T+7),";",3)
62 .S:MISSING[2 ARRAY($$UP,2)=$P($T(T+8),";",3)
63 .S:MISSING[3 ARRAY($$UP,2)=$P($T(T+9),";",3)
64 .;S:MISSING[4 ARRAY($$UP,2)=$P($T(T+10),";",3)
65 ;
66 I MISSING="" S ARRAY($$UP,2)=$P($T(T+5),";",3)
67 ;S MESSAGE=MESSAGE_$P($T(T+6),";",3)
68 ;S MESSAGE=MESSAGE_"^Current GEC Referral Status"
69 ;
70 Q
71UP() ;
72 S CNT=CNT+1
73 Q CNT
74 ;
75T ;TEXT
76 ;; Social Services,
77 ;; Nursing Assessment,
78 ;; Care Recommendations,
79 ;; Care Coordination
80 ;;
81 ;;Is this Referral Complete?
82 ;; Social Services
83 ;; Nursing Assessment
84 ;; Care Recommendations
85 ;; Care Coordination
86 ;;The Following Dialogs are Missing:
87 ;; ~~(If you select Yes, the current REFERRAL ~will be completed and any missing ~information cannot be added.
88 ;; ~~If you select No, the current REFERRAL ~will include the addition of missing information.)
89 Q
Note: See TracBrowser for help on using the repository browser.