Changeset 636 for FOIAVistA/tag/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWPT.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWPT.m (modified) (7 diffs)

FOIAVistA/tag/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWPT.m

@@ -1 @@
-ORWPT ; SLC/KCM/REV - Patient Lookup Functions ;3/18/05  10:50
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,132,149,206,187,190,215**;Dec 17, 1997
- ;
- ; Ref. to ^UTILITY via IA 10061
- ; 
+ORWPT ; SLC/KCM/REV - Patient Lookup Functions ;11/23/06  10:50
+ ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,132,149,206,187,190,215,269**;Dec 17, 1997 LOCAL ;Build 28
+ ; Modified from FOIA VISTA,
+ ; Copyright (C) 2007 WorldVistA
+ ;
+ ; This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU General Public License
+ ;;VOE VWPT PACKAGE ENHANCEMENT UPDATES ADDED 11/14/06
+ ;
+ Q 
 IDINFO(REC,DFN) ; Return identifying information for a patient
+ ;VWPT BELOW ADD HRN AND ALT HRN
+ ; PID^DOB^SEX^VET^SC%^WARD^RM-BED^NAME^HRN^ALTHRN
  ; PID^DOB^SEX^VET^SC%^WARD^RM-BED^NAME
  N X0,X1,X101,X3,XV  ; name/dob/sex/ssn, ward, room-bed, sc%, vet
  S X0=$G(^DPT(DFN,0)),X1=$G(^(.1)),X101=$G(^(.101)),X3=$G(^(.3)),XV=$G(^("VET"))
- S REC=$$SSN^DPTLK1(DFN)_U_$$DOB^DPTLK1(DFN,2)_U_$P(X0,U,2)_U_$P(XV,U)_U_$P(X3,U,2)_U_$P(X1,U)_U_$P(X101,U)_U_$P(X0,U) ;DG249
- Q
+ ;VWPT ENHANCED
+ N HRN,ID
+ S HRN=$$HRN^DGLBPID(DFN)
+ S ID=$$ID^DGLBPID(DFN)
+ I (ID=HRN)&(HRN'="") D
+ .S REC=U_$$DOB^DPTLK1(DFN,2)_U_$P(X0,U,2)_U_$P(XV,U)_U_$P(X3,U,2)_U_$P(X1,U)_U_$P(X101,U)_U_$P(X0,U)_U_$$HRNRET(DFN)_U_$$ALTHRN^ORWPT2(DFN) ;DG249
+ E  D
+ .S REC=$$ID^DGLBPID(DFN)_U_$$DOB^DPTLK1(DFN,2)_U_$P(X0,U,2)_U_$P(XV,U)_U_$P(X3,U,2)_U_$P(X1,U)_U_$P(X101,U)_U_$P(X0,U)_U_$$HRNRET(DFN)_U_$$ALTHRN^ORWPT2(DFN) ;DG249
+ ;S REC=$$SSN^DPTLK1(DFN)_U_$$DOB^DPTLK1(DFN,2)_U_$P(X0,U,2)_U_$P(XV,U)_U_$P(X3,U,2)_U_$P(X1,U)_U_$P(X101,U)_U_$P(X0,U) ;DG249
+ ;END VWPT
+ Q
+ ;VWPT RETURN HRN .CHECK FOR "sensitive" patients
+HRNRET(DFN) ;
+ N IRET
+ S IRET=$$HRN^DGLBPID(DFN) ;$$HRN^VWVOEDPT(DFN)
+ ;I (IRET'="")&$$SCREEN^DPTLK1(DFN) Q "*SENSITIVE*"  ;"HRN SENSITIVE"
+ I (IRET'="") Q "'"_IRET_"'" ;"HRN:"_"'"_IRET_"'"
+ Q ""
+ ; END VWPT
 PTINQ(REF,DFN) ; Return formatted pt inquiry report
  K ^TMP("ORDATA",$J,1)
@@ -43 +67 @@
  ;  1    2   3   4    5      6    7    8       9       10      11  12
  ; NAME^SEX^DOB^SSN^LOCIEN^LOCNM^RMBD^CWAD^SENSITIVE^ADMITTED^CONV^SC^
- ; 13  14  15  16
- ; SC%^ICN^AGE^TS
+ ;VWPT HRN , ALTERNATE HRN
+ ; 13  14  15  16  17  18
+ ; SC%^ICN^AGE^TS^HRN^AltHRN
+ ; ;
+ ; ;end vwpt
+ ;
  ;
  ; for CCOW (RV - 2/27/03)  name="-1", location=error message
  I '$D(^DPT(DFN,0)) S REC="-1^^^^^Patient is unknown to CPRS." Q
  ;
- N X
+ N X,ID,HRN
  K ^TMP("ORWPCE",$J) ; delete PCE 'cache' when switching patients
- S X=^DPT(DFN,0),REC=$P(X,U,1,3)_U_$P(X,U,9)_U_U_$G(^(.1))_U_$G(^(.101))
- S X=$P(REC,U,6) I $L(X) S $P(REC,U,5)=+$G(^DIC(42,+$O(^DIC(42,"B",X,0)),44))
- S $P(REC,U,8)=$$CWAD^ORQPT2(DFN)_U_$$EN1^ORQPT2(DFN)
- ; I $P(REC,U,9) D EN2^ORQPT2(DFN)  ;update DG security log ; DG249
- S X=$G(^DPT(DFN,.105)) I X S $P(REC,U,10)=$P($G(^DGPM(X,0)),U)
- S:'$D(IOST) IOST="P-OTHER"
- S $P(REC,U,11)=$$OTF^OR3CONV(DFN,1)
- D ELIG^VADPT S $P(REC,U,12)=$G(VAEL(3)) ;two pieces: SC^SC%
- I $L($T(GETICN^MPIF001)) S X=+$$GETICN^MPIF001(DFN) S:X>0 $P(REC,U,14)=X
+ D VWPT1^ORWPT2 ;moved code to ORWPT2 to save space
  S $P(REC,U,15)=$$AGE(DFN,$P(REC,U,3))
  S $P(REC,U,16)=+$G(^DPT(DFN,.103)) ; treating specialty
- K VAEL,VAERR ;VADPT call to kill?
- S ^DISV(DUZ,"^DPT(")=DFN
+ D VWPT2^ORWPT2
  Q
 SHARE(VAL,IP,HWND,DFN) ; Set global to share DFN with other applications
@@ -83 +102 @@
  S (I,IEN)=0,XREF=$S($L(ID)=5:"BS5",1:"BS")
  F  S IEN=$O(^DPT(XREF,ID,IEN)) Q:'IEN  D
- . S I=I+1,LST(I)=IEN_U_$P(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$SSN^DPTLK1(IEN)  ; DG249
+ . S I=I+1,LST(I)=IEN_U_$P(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$ID^DGLBPID(IEN) ;$$SSN^DPTLK1(IEN)  ; DG249
  Q
  ;
@@ -98 +117 @@
  .I ((ORPIEN<0)!(ORPIEN="")) Q
  .S ORCNT=ORCNT+1
- .S LST(ORCNT)=ORPIEN_U_$P(^DPT(ORPIEN,0),U)_U_$$DOB^DPTLK1(ORPIEN,2)_U_$$SSN^DPTLK1(ORPIEN) ; DG249.
+ .S LST(ORCNT)=ORPIEN_U_$P(^DPT(ORPIEN,0),U)_U_$$DOB^DPTLK1(ORPIEN,2)_U_$$ID^DGLBPID(ORPIEN) ;$$SSN^DPTLK1(ORPIEN) ; DG249.
  ;
  Q
@@ -106 +125 @@
  S (I,IEN)=0
  F  S IEN=$O(^DPT("SSN",ID,IEN)) Q:'IEN  D
- . S I=I+1,LST(I)=IEN_U_$P(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$SSN^DPTLK1(IEN)  ; DG249
+ . S I=I+1,LST(I)=IEN_U_$P(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$ID^DGLBPID(IEN) ;$$SSN^DPTLK1(IEN)  ; DG249
  Q
  ;
@@ -124 +143 @@
  ..I (ORPIEN'=ORPT) Q
  ..S ORCNT=ORCNT+1
- ..S LST(ORCNT)=ORPIEN_U_$P(^DPT(ORPIEN,0),U)_U_$$DOB^DPTLK1(ORPIEN,2)_U_$$SSN^DPTLK1(ORPIEN) ; DG249.
+ ..S LST(ORCNT)=ORPIEN_U_$P(^DPT(ORPIEN,0),U)_U_$$DOB^DPTLK1(ORPIEN,2)_U_$$ID^DGLBPID(ORPIEN) ;SSN^DPTLK1(ORPIEN) ; DG249.
  ;
  Q
@@ -237 +256 @@
  ;NDBI(X) ; National Database Integration site 1 = yes  0 = no
  ; N R,G S X="A7RDUP" X ^%ZOSF("TEST") S R=$T,G=$S($D(^A7RCP):1,1:0),X=R+G,X=$S(X=2:1,1:0) Q X
+ ;