| [613] | 1 | VAFCSB ;BIR/CMC-CONT ADT PROCESSOR TO RETRIGGER A08 or A04 MESSAGES WITH AL/AL (COMMIT/APPLICATION) ACKNOWLEDGEMENTS ;8/21/06
|
|---|
| 2 | ;;5.3;Registration;**707,756**;Aug 13, 1993;Build 5
|
|---|
| 3 | ;
|
|---|
| 4 | ;Reference to $$XAMDT^RAO7UTL1 is supported by IA #4875
|
|---|
| 5 | ;Reference to RESUTLS^LRPXAPI is supported by IA #4245
|
|---|
| 6 | ;
|
|---|
| 7 | PV2() ;build pv2 segment
|
|---|
| 8 | N PV2,LSTA,APPT,VASD,VAIP,VARP,VAROOT
|
|---|
| 9 | S PV2=""
|
|---|
| 10 | ;get next outpatient appointment
|
|---|
| 11 | K ^UTILITY("VASD",$J) S VASD("F")=DT D SDA^VADPT
|
|---|
| 12 | S APPT=$P($G(^UTILITY("VASD",$J,1,"I")),"^")
|
|---|
| 13 | I APPT'="" S $P(PV2,HL("FS"),9)=$$HLDATE^HLFNC(APPT)
|
|---|
| 14 | ;GET LAST ADMISSION DATE
|
|---|
| 15 | K VAIP S VAIP("D")="LAST",VAIP("M")=0 D IN5^VADPT
|
|---|
| 16 | I VAIP(2)="1^ADMISSION" S $P(PV2,HL("FS"),15)=$$HLDATE^HLFNC($P(VAIP(3),"^"))
|
|---|
| 17 | ;get last registration
|
|---|
| 18 | S VAROOT="VARP"
|
|---|
| 19 | D REG^VADPT
|
|---|
| 20 | I $D(VARP(1,"I")),$G(VARP(1,"I"))>0 S $P(PV2,HL("FS"),46)=$$HLDATE^HLFNC($P(VARP(1,"I"),"^"),"DT"),$P(PV2,HL("FS"),24)="CR"
|
|---|
| 21 | ;**756 ^ ONLY RETURN DATE FOR LAST REGISTRATION AS HL7 STANDARD CAN ONLY HAVE DATE
|
|---|
| 22 | I PV2'="" S PV2="PV2"_HL("FS")_PV2
|
|---|
| 23 | Q PV2
|
|---|
| 24 | PHARA() ;build obx to show active prescriptions
|
|---|
| 25 | N RET S RET=""
|
|---|
| 26 | I '$$PATCH^XPDUTL("PSS*1.0*101") Q RET
|
|---|
| 27 | N PHARM,DGLIST
|
|---|
| 28 | S PHARM="" D PROF^PSO52API(DFN,"DGLIST")
|
|---|
| 29 | I +$G(^TMP($J,"DGLIST",DFN,0))>0 S PHARM="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"ACTIVE PRESCRIPTIONS"_HL("FS")_HL("FS")_"Y"
|
|---|
| 30 | ;**756 CE added as the data type
|
|---|
| 31 | Q PHARM
|
|---|
| 32 | LABE() ;BUILD OBX FOR LAST LAB TEST DATE
|
|---|
| 33 | N OBX S OBX=""
|
|---|
| 34 | I '$$PATCH^XPDUTL("LR*5.2*295") Q OBX
|
|---|
| 35 | N LAB,LAB2,EN
|
|---|
| 36 | S LAB="" K ^TMP("DGLAB",$J) D RESULTS^LRPXAPI("DGLAB",DFN,"C")
|
|---|
| 37 | S EN=$O(^TMP("DGLAB",$J,"")) I EN'="" S LAB=$P($G(^TMP("DGLAB",$J,EN)),"^")
|
|---|
| 38 | K ^TMP("DGLAB",$J) D RESULTS^LRPXAPI("DGLAB",DFN,"A")
|
|---|
| 39 | S EN=$O(^TMP("DGLAB",$J,"")) I EN'="" S LAB2=$P($G(^TMP("DGLAB",$J,EN)),"^") I LAB2>LAB S LAB=LAB2
|
|---|
| 40 | K ^TMP("DGLAB",$J) D RESULTS^LRPXAPI("DGLAB",DFN,"M")
|
|---|
| 41 | S EN=$O(^TMP("DGLAB",$J,"")) I EN'="" S LAB2=$P($G(^TMP("DGLAB",$J,EN)),"^") I LAB2>LAB S LAB=LAB2
|
|---|
| 42 | I LAB'="" D
|
|---|
| 43 | .S $P(OBX,HL("FS"),2)="TS" ;**756 added the data type
|
|---|
| 44 | .S $P(OBX,HL("FS"),3)="LAST LAB TEST DATE/TIME"
|
|---|
| 45 | .S $P(OBX,HL("FS"),11)="F"
|
|---|
| 46 | .S $P(OBX,HL("FS"),14)=$$HLDATE^HLFNC(LAB)
|
|---|
| 47 | .S OBX="OBX"_HL("FS")_OBX
|
|---|
| 48 | Q OBX
|
|---|
| 49 | RADE() ;BUILD OBX FOR LAST RADIOLOGY TEST DATE
|
|---|
| 50 | N RET S RET=""
|
|---|
| 51 | I '$$PATCH^XPDUTL("RA*5.0*76") Q RET
|
|---|
| 52 | N RAD,RADE
|
|---|
| 53 | S RAD="",RADE=$$XAMDT^RAO7UTL1(DFN) I +RADE<1 Q RAD
|
|---|
| 54 | I +RADE>0 D
|
|---|
| 55 | .S $P(OBX,HL("FS"),2)="TS" ;**756 added the data type
|
|---|
| 56 | .S $P(RAD,HL("FS"),3)="LAST RADIOLOGY EXAM DATE/TIME"
|
|---|
| 57 | .S $P(RAD,HL("FS"),11)="F"
|
|---|
| 58 | .S $P(RAD,HL("FS"),14)=$$HLDATE^HLFNC(RADE)
|
|---|
| 59 | .S RAD="OBX"_HL("FS")_RAD
|
|---|
| 60 | Q RAD
|
|---|
| 61 | PD1() ;BUILD PD1 segment
|
|---|
| 62 | ;PREFERRED FACILITY -- NOT GOING TO BE PASSED PER IMDQ 9/7/06
|
|---|
| 63 | N TEAM,PD1
|
|---|
| 64 | S PD1=""
|
|---|
| 65 | ;S TEAM=$$PREF^DGENPTA(DFN)
|
|---|
| 66 | ;I TEAM'="" S PD1="PD1"_HL("FS")_HL("FS")_HL("FS")_$$STA^XUAF4(TEAM)
|
|---|
| 67 | Q PD1
|
|---|
| 68 | PV1() ;BUILD PV1 SEGMENT
|
|---|
| 69 | ;CURRENTLY ADMITTED?
|
|---|
| 70 | N PV1,VAINDT
|
|---|
| 71 | S PV1=""
|
|---|
| 72 | S VAINDT=DT
|
|---|
| 73 | D INP^VADPT
|
|---|
| 74 | I $G(VAIN(1))'="" S $P(PV1,HL("FS"),44)=$$HLDATE^HLFNC($P(VAIN(7),"^")),PV1="PV1"_HL("FS")_PV1
|
|---|
| 75 | K VAIN
|
|---|
| 76 | Q PV1
|
|---|
