| [613] | 1 | TIUPP3 ;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
|
|---|
| 3 | ENCOVER(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 | ;
|
|---|
| 10 | PTPLKP ;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 | ;
|
|---|
| 23 | BUILD(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 | ;
|
|---|
| 35 | BLDG(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 | ;
|
|---|
| 44 | GETADD(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")_")"
|
|---|
| 51 | GETADX Q TIUY
|
|---|
| 52 | ;
|
|---|
| 53 | DOCDEF ;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
|
|---|
