source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPP3.m@ 1556

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

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1TIUPP3 ;SLC/DJP - Patient Posting Cover Sheet API ; 5-JAN-2000 12:38:05
2 ;;1.0;TEXT INTEGRATION UTILITIES;**4,54,80**;Jun 20, 1997
3ENCOVER(DFN) ; Supports CWAD Display.
4 N TIUPP K ^TMP("TIUPPCV",$J)
5 I +$G(DFN)'>0 S MSG="-1^DFN required." Q
6 D PTPLKP I TIUPP("DATA")="" S MSG="-1^No Patient Postings on file" Q
7 S MSG="0^Patient Postings on file"
8 Q
9 ;
10PTPLKP ;Lookup and listing of Patient Posting indicators
11 N CTR,GMRARXN,PTP,TIUCN,TIUCW,TIUAR,TIUSTS
12 D DOCDEF S TIUPP("DATA")="",CTR=0
13 D EN1^GMRAOR1(DFN,"GMRARXN")
14 I $G(GMRARXN) D D BLDG(.PTP,.CTR)
15 .S PTP("IEN")="",PTP("ACRN")="A",PTP("CN")="ALLERGIES"
16 .S PTP("MOD")="Known allergies",PTP("DATE")=""
17 F TIUSTS=7,8 D
18 .I $D(^TIU(8925,"ADCPT",+DFN,TIUCN,TIUSTS)) S PTP("ACRN")="C",PTP("CN")="CRISIS NOTE" D BUILD(TIUCN,TIUSTS,.PTP,.CTR)
19 .I $D(^TIU(8925,"ADCPT",+DFN,TIUCW,TIUSTS)) S PTP("ACRN")="W",PTP("CN")="CLINICAL WARNING" D BUILD(TIUCW,TIUSTS,.PTP,.CTR)
20 .I $D(^TIU(8925,"ADCPT",+DFN,TIUAR,TIUSTS)) S PTP("ACRN")="D",PTP("CN")="ADVANCE DIRECTIVE" D BUILD(TIUAR,TIUSTS,.PTP,.CTR)
21 Q
22 ;
23BUILD(TYPE,STATUS,PTP,CTR) ;Sets PTP Array elements for BLDG
24 N TIUDT S TIUDT=0
25 F S TIUDT=$O(^TIU(8925,"ADCPT",+DFN,TYPE,STATUS,TIUDT)) Q:+TIUDT'>0 D
26 .N IEN S IEN=0
27 .F S IEN=$O(^TIU(8925,"ADCPT",+DFN,TYPE,STATUS,TIUDT,IEN)) Q:+IEN'>0 D
28 ..S PTP("IEN")=IEN
29 ..S PTP("TITLE")=$$PNAME^TIULC1(+$G(^TIU(8925,IEN,0)))
30 ..S PTP("MOD")=$P($G(^TIU(8925,IEN,17)),U)
31 ..S PTP("DATE")=9999999-TIUDT
32 ..D BLDG(.PTP,.CTR)
33 Q
34 ;
35BLDG(PTP,CTR) ;Build ^TMP("TIUPPCV",$J,
36 ;IEN^Acronym^Category Name^Optional Modifier^Date/Time^Optional Addendum
37 N TIUREC
38 S TIUPP("DATA")=TIUPP("DATA")_PTP("ACRN")
39 S CTR=CTR+1,TIUREC=PTP("IEN")_U_PTP("ACRN")_U_$S($L($G(PTP("TITLE"))):$G(PTP("TITLE")),1:PTP("CN"))_U_PTP("MOD")_U_PTP("DATE")
40 I PTP("ACRN")'="A" S TIUREC=TIUREC_U_$$GETADD(PTP("IEN"))
41 S ^TMP("TIUPPCV",$J,CTR)=TIUREC
42 Q
43 ;
44GETADD(TIUDA) ;Gets most recent addendum of a posting
45 N ADD,TIUY,TIUD0,TIUDT S TIUY=""
46 S ADD="",ADD=$O(^TIU(8925,"DAD",TIUDA,ADD),-1) G:+ADD'>0 GETADX
47 S TIUD0=$G(^TIU(8925,ADD,0))
48 I $S($P(TIUD0,U,5)=7:0,$P(TIUD0,U,5)=8:0,1:1) G GETADX
49 S TIUDT=$P($G(^TIU(8925,ADD,12)),U) G:'+TIUDT GETADX
50 S TIUY=" (addendum "_$$DATE^TIULS(TIUDT,"MM/DD/YY HR:MIN")_")"
51GETADX Q TIUY
52 ;
53DOCDEF ;Sets IENs for lookup on specific Document Types/Status
54 N TIUDC,TIUX,TIUST
55 S TIUX="CLINICAL WARNING"
56 S TIUDC=0 F S TIUDC=$O(^TIU(8925.1,"B",TIUX,TIUDC)) Q:+TIUDC'>0!+$G(TIUCW) D
57 . I $P($G(^TIU(8925.1,+TIUDC,0)),U,4)="DC" S TIUCW=+TIUDC
58 S TIUX="CRISIS NOTE"
59 S TIUDC=0 F S TIUDC=$O(^TIU(8925.1,"B",TIUX,TIUDC)) Q:+TIUDC'>0!+$G(TIUCN) D
60 . I $P($G(^TIU(8925.1,+TIUDC,0)),U,4)="DC" S TIUCN=+TIUDC
61 S TIUX="ADVANCE DIRECTIVE"
62 S TIUDC=0 F S TIUDC=$O(^TIU(8925.1,"B",TIUX,TIUDC)) Q:+TIUDC'>0!+$G(TIUAR) D
63 . I $P($G(^TIU(8925.1,+TIUDC,0)),U,4)="DC" S TIUAR=+TIUDC
64 S:'$D(TIUCW) TIUCW=0
65 S:'$D(TIUCN) TIUCN=0
66 S:'$D(TIUAR) TIUAR=0
67 Q
Note: See TracBrowser for help on using the repository browser.