Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMVRPCP

GMVRPCP.m

Go to the documentation of this file. 
  1. GMVRPCP ;HOIFO/DP-RPC for GMV_PtSelect.pas ; 7/8/05 8:05am
  1.  ;;5.0;GEN. MED. REC. - VITALS;**1,3,22**;Oct 31, 2002;Build 22
  1.  ; Integration Agreements:
  1.  ; IA# 510 [Controlled] Calls to set ^DISV
  1.  ; IA# 3027 [Supported] Calls to DGSEC4
  1.  ; IA# 3266 [Controlled] Calls to DOB^DPTLK1
  1.  ; IA# 3267 [Controlled] Calls to SSN^DPTLK1
  1.  ; IA# 3593 [Supported] Calls to DPTLK6
  1.  ; IA# 4440 [Supported] XUPROD calls
  1.  ; IA# 10035 [Supported] Calls for FILE 2 references.
  1.  ; IA# 10039 [Supported] Reads of ^DIC(42,#,44)
  1.  ; IA# 10040 [Supported] Reads of ^SC(
  1.  ; IA# 10061 [Supported] Calls to VADPT
  1.  ; IA# 10112 [Supported] VASITE calls
  1.  ;
  1. ADD(X) ; [Procedure] Add line to @RESULTS@(...
  1.  ; Input parameters
  1.  ;  1. X [Literal/Required] Data to add to @RESULTS@(...
  1.  S @RESULTS@(+$O(@RESULTS@(""),-1)+1)=X
  1.  Q
  1.  ;
  1. LOGSEC ; [Procedure] Log Security
  1.  D NOTICE^DGSEC4(.GMVRET,DFN,DATA,3)
  1.  S @RESULTS@(0)=$S(GMVRET:"1^Logged",1:"-1^Unable to log")
  1.  Q
  1.  ;
  1. RPC(RESULTS,OPTION,DFN,DATA) ; [Procedure] Main RPC call tag
  1.  ; RPC: [GMV PTSELECT]
  1.  ; Input parameters
  1.  ;  1. RESULTS [Literal/Required] RPC return array
  1.  ;  2. OPTION [Literal/Required] Call method for RPC
  1.  ;  3. DFN [Literal/Required] Patient IEN
  1.  ;  4. DATA [Literal/Optional] Other data as required for call
  1.  S RESULTS=$NA(^TMP("GMVPTSELECT",$J)) K @RESULTS
  1.  D:$T(@OPTION)]"" @OPTION
  1.  D:'$D(@RESULTS)
  1.  .S @RESULTS@(0)="-1^No results returned"
  1.  D CLEAN^DILF
  1.  Q
  1.  ;
  1. HOSPLOC ; [Procedure] Return location as ptr to 44 or ""
  1.  N VAIN
  1.  D INP^VADPT S @RESULTS@(0)=+$G(^DIC(42,+VAIN(4),44),"")
  1.  Q
  1.  ;
  1. PTHDR ; [Procedure] Patient Info for Header Displays
  1.  I '$D(^DPT(+$G(DFN),0)) D  Q
  1.  .S @RESULTS@(0)="-1^No Such DFN ["_$G(DFN,"<Null>")_"]"
  1.  N GMVIENS
  1.  S @RESULTS@(0)=+DFN,GMVIENS=(+DFN)_","
  1.  S @RESULTS@(1)=$$GET1^DIQ(2,GMVIENS,.01)_"  "_$$GET1^DIQ(2,GMVIENS,.09)
  1.  S @RESULTS@(2)="DOB: "_$$GET1^DIQ(2,GMVIENS,.03)_" "_$$GET1^DIQ(2,GMVIENS,.02)_", Age: "_$$GET1^DIQ(2,GMVIENS,.033)
  1.  Q
  1.  ;
  1. PTLKUP ; [Procedure] Patient lookup handled separately for security
  1.  N GMVIDX
  1.  S GMVIDX=$S(DATA?9N.1"P":"SSN",1:"B^BS^BS5")
  1.  D FIND^DIC(2,"","@;.01;.02;.03;.09","MP",DATA,60,GMVIDX)
  1.  I $P(^TMP("DILIST",$J,0),U,3) D  Q
  1.  .S @RESULTS@(0)="-1^Too many patients found matching '"_DATA_"'. Please be more specific."
  1.  F GMV=0:0 S GMV=$O(^TMP("DILIST",$J,GMV)) Q:'GMV  D
  1.  .S @RESULTS@(GMV)=$$PTREC(+^TMP("DILIST",$J,GMV,0))
  1.  I '$D(@RESULTS) S @RESULTS@(0)="-1^No patients matching '"_DATA_"'"
  1.  E  S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
  1.  Q
  1.  ;
  1. PTREC(DFN) ;
  1.  ; Extrinsic to return a Pt Rec  in standard list format
  1.  N GMV
  1.  S GMV=$G(^DPT(DFN,0))
  1.  S GMV="2;"_DFN_U_$P(GMV,U,1)_U_$P(GMV,U,2)_U_$P(GMV,U,3)_U_$P(GMV,U,9)
  1.  S $P(GMV,U,10)=$$DOB^DPTLK1(DFN)
  1.  S $P(GMV,U,11)=$$SSN^DPTLK1(DFN)
  1.  Q GMV
  1.  ;
  1. SELECT ; [Procedure] Select patient
  1.  ; Calls required utilities to check security and
  1.  ; return associated warnings/alerts about a
  1.  ; patient being selected.
  1.  ; Variables:
  1.  ;  IENS: [Private] Fileman IENS
  1.  ;  GMVDFN: [Private] Scratch
  1.  ;  GMVFLD: [Private] FIeld number
  1.  ;  GMVID: [Private] Identifier array
  1.  ;  GMVRET: [Private] Scratch
  1.  ;  GMVX: [Private] Scratch
  1.  ; New private variables
  1.  NEW IENS,GMVCNT,GMVDFN,GMVFLD,GMVHLIEN,GMVI,GMVID,GMVIDS,GMVRET,GMVX,GMVIDIEN
  1.  I '$D(^DPT(+$G(DFN),0))#2 S @RESULTS@(0)="-1^No such patient" Q
  1.  S ^DISV(DUZ,"^DPT(")=DFN ;spacebar return
  1.  S @RESULTS@(0)="1^Required Identifiers & messages"
  1.  S IENS=DFN_","
  1.  D FILE^DID(2,,"REQUIRED IDENTIFIERS","GMVIDS")
  1.  F GMVX=0:0 S GMVX=$O(GMVIDS("REQUIRED IDENTIFIERS",GMVX)) Q:'GMVX  D
  1.  .S GMVFLD=GMVIDS("REQUIRED IDENTIFIERS",GMVX,"FIELD")
  1.  .S GMVID="$$PTID^"_$$GET1^DID(2,GMVFLD,"","LABEL")
  1.  .S GMVID=GMVID_U_$$GET1^DIQ(2,IENS,GMVFLD)
  1.  .D:GMVFLD=.03
  1.  ..S GMVID=GMVID_" ("_$$GET1^DIQ(2,IENS,.033)_")"
  1.  ..S GMVID=GMVID_U_$$DOB^DPTLK1(+IENS)
  1.  .D:GMVFLD=.09
  1.  ..S X=$P(GMVID,U,3),X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10)
  1.  ..S $P(GMVID,U,3)=X,$P(GMVID,U,4)=$$SSN^DPTLK1(+IENS)
  1.  .S @RESULTS@($O(@RESULTS@(""),-1)+1)=GMVID
  1.  ; Add ward and Room/Bed
  1.  S GMVID="$$PTID^"_$$GET1^DID(2,.1,"","LABEL")
  1.  S GMVID=GMVID_U_$$GET1^DIQ(2,IENS,.1)
  1.  S GMVIDIEN=$P(GMVID,U,3)
  1.  S GMVIDIEN=$$IDIEN(GMVIDIEN)
  1.  S @RESULTS@($O(@RESULTS@(""),-1)+1)=GMVID
  1.  S GMVID="$$PTID^"_$$GET1^DID(2,.101,"","LABEL")
  1.  S GMVID=GMVID_U_$$GET1^DIQ(2,IENS,.101)
  1.  S @RESULTS@($O(@RESULTS@(""),-1)+1)=GMVID
  1.  ; ------- Clevland Alert -------
  1.  K GMVRET
  1.  D GUIBS5A^DPTLK6(.GMVRET,DFN) D:GMVRET(1)=1
  1.  .D ADD("$$MSGHDR^2^SAME LAST NAME AND LAST 4")
  1.  .S GMVX=1
  1.  .F  S GMVX=$O(GMVRET(GMVX)) Q:'GMVX!(+$G(GMVRET(GMVX)))  D
  1.  ..D ADD($P(GMVRET(GMVX),U,2))
  1.  .D ADD(" ")
  1.  .S GMVX=1
  1.  .F  S GMVX=$O(GMVRET(GMVX)) Q:'GMVX  D:+GMVRET(GMVX)
  1.  ..S GMVDFN=+$P(GMVRET(GMVX),U,2)
  1.  ..D ADD($$GET1^DIQ(2,GMVDFN_",",.01)_"    "_$$DOB^DPTLK1(GMVDFN)_"    "_$$SSN^DPTLK1(GMVDFN))
  1.  .D ADD(" ")
  1.  .D ADD("Please review carefully before continuing")
  1.  .D ADD("$$MSGEND")
  1.  ; ------- Sensitive Record? -------
  1.  K GMVRET
  1.  D PTSEC^DGSEC4(.GMVRET,DFN) D:GMVRET(1)'=0
  1.  .D:GMVRET(1)=3
  1.  ..D ADD("$$MSGHDR^0^CAN'T ACCESS YOUR OWN RECORD!!")
  1.  .D:GMVRET(1)=-1
  1.  ..D ADD("$$MSGHDR^0^INCOMPLETE INFORMATION - CAN'T PROCEED")
  1.  .D:GMVRET(1)=1
  1.  ..D ADD("$$MSGHDR^1^SENSITIVE RECORD ACCESS")
  1.  .D:GMVRET(1)'=-1&(GMVRET(1)'=3)&(GMVRET(1)'=1)
  1.  ..D ADD("$$MSGHDR^3^SENSITIVE RECORD ACCESS")
  1.  .S GMVX=1
  1.  .F  S GMVX=$O(GMVRET(GMVX)) Q:'GMVX  D ADD($TR(GMVRET(GMVX),"*"," "))
  1.  .D ADD("$$MSGEND")
  1.  ; ------- Means Test Information? -------
  1.  D GUIMTD^DPTLK6(.GMVRET,DFN) D:GMVRET(1)=1
  1.  .D ADD("$$MSGHDR^1^NOTICE")
  1.  .F GMVX=1:0 S GMVX=$O(GMVRET(GMVX)) Q:'GMVX  D ADD(GMVRET(GMVX))
  1.  .D ADD("$$MSGEND")
  1.  Q
  1.  ;
  1. IDIEN(GMVIEN) ;
  1.  S GMVIEN=$G(GMVIEN)
  1.  I GMVIEN="" Q ""
  1.  S GMVIEN=$O(^DIC(42,"B",GMVIEN,0))
  1.  I 'GMVIEN Q ""
  1.  S GMVIEN=$P($G(^DIC(42,+GMVIEN,44)),"U",1)
  1.  Q GMVIEN
  1.  ;
  1. CCOW ; Return CCOW site and production indicator
  1.  S @RESULTS@(0)=$P($$SITE^VASITE(),"^",3)_"^"_$$PROD^XUPROD()
  1.  Q
  1.  ;