GMVRPCP ;HOIFO/DP-RPC for GMV_PtSelect.pas ; 7/8/05 8:05am
;;5.0;GEN. MED. REC. - VITALS;**1,3,22,29**;Oct 31, 2002;Build 7
; Integration Agreements:
; IA# 510 [Controlled] Calls to set ^DISV
; IA# 3027 [Supported] Calls to DGSEC4
; IA# 3266 [Controlled] Calls to DOB^DPTLK1
; IA# 3267 [Controlled] Calls to SSN^DPTLK1
; IA# 3593 [Supported] Calls to DPTLK6
; IA# 4440 [Supported] XUPROD calls
; IA# 5888 [Controlled] Calls to VIC API
; IA# 10035 [Supported] Calls for FILE 2 references.
; IA# 10039 [Supported] Reads of ^DIC(42,#,44)
; IA# 10040 [Supported] Reads of ^SC(
; IA# 10061 [Supported] Calls to VADPT
; IA# 10112 [Supported] VASITE calls
;
; 01/28/2014 KAM GMRV*5*29 Add Call to VIC API during patient lookup
;
ADD(X) ; [Procedure] Add line to @RESULTS@(...
; Input parameters
; 1. X [Literal/Required] Data to add to @RESULTS@(...
S @RESULTS@(+$O(@RESULTS@(""),-1)+1)=X
Q
;
LOGSEC ; [Procedure] Log Security
D NOTICE^DGSEC4(.GMVRET,DFN,DATA,3)
S @RESULTS@(0)=$S(GMVRET:"1^Logged",1:"-1^Unable to log")
Q
;
RPC(RESULTS,OPTION,DFN,DATA) ; [Procedure] Main RPC call tag
; RPC: [GMV PTSELECT]
; Input parameters
; 1. RESULTS [Literal/Required] RPC return array
; 2. OPTION [Literal/Required] Call method for RPC
; 3. DFN [Literal/Required] Patient IEN
; 4. DATA [Literal/Optional] Other data as required for call
S RESULTS=$NA(^TMP("GMVPTSELECT",$J)) K @RESULTS
D:$T(@OPTION)]"" @OPTION
D:'$D(@RESULTS)
.S @RESULTS@(0)="-1^No results returned"
D CLEAN^DILF
Q
;
HOSPLOC ; [Procedure] Return location as ptr to 44 or ""
N VAIN
D INP^VADPT S @RESULTS@(0)=+$G(^DIC(42,+VAIN(4),44),"")
Q
;
PTHDR ; [Procedure] Patient Info for Header Displays
I '$D(^DPT(+$G(DFN),0)) D Q
.S @RESULTS@(0)="-1^No Such DFN ["_$G(DFN,"<Null>")_"]"
N GMVIENS
S @RESULTS@(0)=+DFN,GMVIENS=(+DFN)_","
S @RESULTS@(1)=$$GET1^DIQ(2,GMVIENS,.01)_" "_$$GET1^DIQ(2,GMVIENS,.09)
S @RESULTS@(2)="DOB: "_$$GET1^DIQ(2,GMVIENS,.03)_" "_$$GET1^DIQ(2,GMVIENS,.02)_", Age: "_$$GET1^DIQ(2,GMVIENS,.033)
Q
;
PTLKUP ; [Procedure] Patient lookup handled separately for security
N GMVIDX,CARDRSLT
;
; 01/28/2014 KAM GMRV*5*29 Add Call to VIC API during patient lookup
;(next two lines)
D RPCVIC^DPTLK(.CARDRSLT,DATA) ;SUPPLIED VHIC CARD API
I CARDRSLT>0 S DATA="`"_CARDRSLT
; The Variable DATA is unchanged if CARDRSLT is < 0
;
S GMVIDX=$S(DATA?9N.1"P":"SSN",1:"B^BS^BS5")
D FIND^DIC(2,"","@;.01;.02;.03;.09","MP",DATA,60,GMVIDX)
I $P(^TMP("DILIST",$J,0),U,3) D Q
.S @RESULTS@(0)="-1^Too many patients found matching '"_DATA_"'. Please be more specific."
F GMV=0:0 S GMV=$O(^TMP("DILIST",$J,GMV)) Q:'GMV D
.S @RESULTS@(GMV)=$$PTREC(+^TMP("DILIST",$J,GMV,0))
I '$D(@RESULTS) S @RESULTS@(0)="-1^No patients matching '"_DATA_"'"
E S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
Q
;
PTREC(DFN) ;
; Extrinsic to return a Pt Rec in standard list format
N GMV
S GMV=$G(^DPT(DFN,0))
S GMV="2;"_DFN_U_$P(GMV,U,1)_U_$P(GMV,U,2)_U_$P(GMV,U,3)_U_$P(GMV,U,9)
S $P(GMV,U,10)=$$DOB^DPTLK1(DFN)
S $P(GMV,U,11)=$$SSN^DPTLK1(DFN)
Q GMV
;
SELECT ; [Procedure] Select patient
; Calls required utilities to check security and
; return associated warnings/alerts about a
; patient being selected.
; Variables:
; IENS: [Private] Fileman IENS
; GMVDFN: [Private] Scratch
; GMVFLD: [Private] FIeld number
; GMVID: [Private] Identifier array
; GMVRET: [Private] Scratch
; GMVX: [Private] Scratch
; New private variables
NEW IENS,GMVCNT,GMVDFN,GMVFLD,GMVHLIEN,GMVI,GMVID,GMVIDS,GMVRET,GMVX,GMVIDIEN
I '$D(^DPT(+$G(DFN),0))#2 S @RESULTS@(0)="-1^No such patient" Q
S ^DISV(DUZ,"^DPT(")=DFN ;spacebar return
S @RESULTS@(0)="1^Required Identifiers & messages"
S IENS=DFN_","
D FILE^DID(2,,"REQUIRED IDENTIFIERS","GMVIDS")
F GMVX=0:0 S GMVX=$O(GMVIDS("REQUIRED IDENTIFIERS",GMVX)) Q:'GMVX D
.S GMVFLD=GMVIDS("REQUIRED IDENTIFIERS",GMVX,"FIELD")
.S GMVID="$$PTID^"_$$GET1^DID(2,GMVFLD,"","LABEL")
.S GMVID=GMVID_U_$$GET1^DIQ(2,IENS,GMVFLD)
.D:GMVFLD=.03
..S GMVID=GMVID_" ("_$$GET1^DIQ(2,IENS,.033)_")"
..S GMVID=GMVID_U_$$DOB^DPTLK1(+IENS)
.D:GMVFLD=.09
..S X=$P(GMVID,U,3),X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10)
..S $P(GMVID,U,3)=X,$P(GMVID,U,4)=$$SSN^DPTLK1(+IENS)
.S @RESULTS@($O(@RESULTS@(""),-1)+1)=GMVID
; Add ward and Room/Bed
S GMVID="$$PTID^"_$$GET1^DID(2,.1,"","LABEL")
S GMVID=GMVID_U_$$GET1^DIQ(2,IENS,.1)
S GMVIDIEN=$P(GMVID,U,3)
S GMVIDIEN=$$IDIEN(GMVIDIEN)
S @RESULTS@($O(@RESULTS@(""),-1)+1)=GMVID
S GMVID="$$PTID^"_$$GET1^DID(2,.101,"","LABEL")
S GMVID=GMVID_U_$$GET1^DIQ(2,IENS,.101)
S @RESULTS@($O(@RESULTS@(""),-1)+1)=GMVID
; ------- Clevland Alert -------
K GMVRET
D GUIBS5A^DPTLK6(.GMVRET,DFN) D:GMVRET(1)=1
.D ADD("$$MSGHDR^2^SAME LAST NAME AND LAST 4")
.S GMVX=1
.F S GMVX=$O(GMVRET(GMVX)) Q:'GMVX!(+$G(GMVRET(GMVX))) D
..D ADD($P(GMVRET(GMVX),U,2))
.D ADD(" ")
.S GMVX=1
.F S GMVX=$O(GMVRET(GMVX)) Q:'GMVX D:+GMVRET(GMVX)
..S GMVDFN=+$P(GMVRET(GMVX),U,2)
..D ADD($$GET1^DIQ(2,GMVDFN_",",.01)_" "_$$DOB^DPTLK1(GMVDFN)_" "_$$SSN^DPTLK1(GMVDFN))
.D ADD(" ")
.D ADD("Please review carefully before continuing")
.D ADD("$$MSGEND")
; ------- Sensitive Record? -------
K GMVRET
D PTSEC^DGSEC4(.GMVRET,DFN) D:GMVRET(1)'=0
.D:GMVRET(1)=3
..D ADD("$$MSGHDR^0^CAN'T ACCESS YOUR OWN RECORD!!")
.D:GMVRET(1)=-1
..D ADD("$$MSGHDR^0^INCOMPLETE INFORMATION - CAN'T PROCEED")
.D:GMVRET(1)=1
..D ADD("$$MSGHDR^1^SENSITIVE RECORD ACCESS")
.D:GMVRET(1)'=-1&(GMVRET(1)'=3)&(GMVRET(1)'=1)
..D ADD("$$MSGHDR^3^SENSITIVE RECORD ACCESS")
.S GMVX=1
.F S GMVX=$O(GMVRET(GMVX)) Q:'GMVX D ADD($TR(GMVRET(GMVX),"*"," "))
.D ADD("$$MSGEND")
; ------- Means Test Information? -------
D GUIMTD^DPTLK6(.GMVRET,DFN) D:GMVRET(1)=1
.D ADD("$$MSGHDR^1^NOTICE")
.F GMVX=1:0 S GMVX=$O(GMVRET(GMVX)) Q:'GMVX D ADD(GMVRET(GMVX))
.D ADD("$$MSGEND")
Q
;
IDIEN(GMVIEN) ;
S GMVIEN=$G(GMVIEN)
I GMVIEN="" Q ""
S GMVIEN=$O(^DIC(42,"B",GMVIEN,0))
I 'GMVIEN Q ""
S GMVIEN=$P($G(^DIC(42,+GMVIEN,44)),"U",1)
Q GMVIEN
;
CCOW ; Return CCOW site and production indicator
S @RESULTS@(0)=$P($$SITE^VASITE(),"^",3)_"^"_$$PROD^XUPROD()
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMVRPCP 6287 printed Nov 22, 2024@17:09:58 Page 2
GMVRPCP ;HOIFO/DP-RPC for GMV_PtSelect.pas ; 7/8/05 8:05am
+1 ;;5.0;GEN. MED. REC. - VITALS;**1,3,22,29**;Oct 31, 2002;Build 7
+2 ; Integration Agreements:
+3 ; IA# 510 [Controlled] Calls to set ^DISV
+4 ; IA# 3027 [Supported] Calls to DGSEC4
+5 ; IA# 3266 [Controlled] Calls to DOB^DPTLK1
+6 ; IA# 3267 [Controlled] Calls to SSN^DPTLK1
+7 ; IA# 3593 [Supported] Calls to DPTLK6
+8 ; IA# 4440 [Supported] XUPROD calls
+9 ; IA# 5888 [Controlled] Calls to VIC API
+10 ; IA# 10035 [Supported] Calls for FILE 2 references.
+11 ; IA# 10039 [Supported] Reads of ^DIC(42,#,44)
+12 ; IA# 10040 [Supported] Reads of ^SC(
+13 ; IA# 10061 [Supported] Calls to VADPT
+14 ; IA# 10112 [Supported] VASITE calls
+15 ;
+16 ; 01/28/2014 KAM GMRV*5*29 Add Call to VIC API during patient lookup
+17 ;
ADD(X) ; [Procedure] Add line to @RESULTS@(...
+1 ; Input parameters
+2 ; 1. X [Literal/Required] Data to add to @RESULTS@(...
+3 SET @RESULTS@(+$ORDER(@RESULTS@(""),-1)+1)=X
+4 QUIT
+5 ;
LOGSEC ; [Procedure] Log Security
+1 DO NOTICE^DGSEC4(.GMVRET,DFN,DATA,3)
+2 SET @RESULTS@(0)=$SELECT(GMVRET:"1^Logged",1:"-1^Unable to log")
+3 QUIT
+4 ;
RPC(RESULTS,OPTION,DFN,DATA) ; [Procedure] Main RPC call tag
+1 ; RPC: [GMV PTSELECT]
+2 ; Input parameters
+3 ; 1. RESULTS [Literal/Required] RPC return array
+4 ; 2. OPTION [Literal/Required] Call method for RPC
+5 ; 3. DFN [Literal/Required] Patient IEN
+6 ; 4. DATA [Literal/Optional] Other data as required for call
+7 SET RESULTS=$NAME(^TMP("GMVPTSELECT",$JOB))
KILL @RESULTS
+8 if $TEXT(@OPTION)]""
DO @OPTION
+9 if '$DATA(@RESULTS)
Begin DoDot:1
+10 SET @RESULTS@(0)="-1^No results returned"
End DoDot:1
+11 DO CLEAN^DILF
+12 QUIT
+13 ;
HOSPLOC ; [Procedure] Return location as ptr to 44 or ""
+1 NEW VAIN
+2 DO INP^VADPT
SET @RESULTS@(0)=+$GET(^DIC(42,+VAIN(4),44),"")
+3 QUIT
+4 ;
PTHDR ; [Procedure] Patient Info for Header Displays
+1 IF '$DATA(^DPT(+$GET(DFN),0))
Begin DoDot:1
+2 SET @RESULTS@(0)="-1^No Such DFN ["_$GET(DFN,"<Null>")_"]"
End DoDot:1
QUIT
+3 NEW GMVIENS
+4 SET @RESULTS@(0)=+DFN
SET GMVIENS=(+DFN)_","
+5 SET @RESULTS@(1)=$$GET1^DIQ(2,GMVIENS,.01)_" "_$$GET1^DIQ(2,GMVIENS,.09)
+6 SET @RESULTS@(2)="DOB: "_$$GET1^DIQ(2,GMVIENS,.03)_" "_$$GET1^DIQ(2,GMVIENS,.02)_", Age: "_$$GET1^DIQ(2,GMVIENS,.033)
+7 QUIT
+8 ;
PTLKUP ; [Procedure] Patient lookup handled separately for security
+1 NEW GMVIDX,CARDRSLT
+2 ;
+3 ; 01/28/2014 KAM GMRV*5*29 Add Call to VIC API during patient lookup
+4 ;(next two lines)
+5 ;SUPPLIED VHIC CARD API
DO RPCVIC^DPTLK(.CARDRSLT,DATA)
+6 IF CARDRSLT>0
SET DATA="`"_CARDRSLT
+7 ; The Variable DATA is unchanged if CARDRSLT is < 0
+8 ;
+9 SET GMVIDX=$SELECT(DATA?9N.1"P":"SSN",1:"B^BS^BS5")
+10 DO FIND^DIC(2,"","@;.01;.02;.03;.09","MP",DATA,60,GMVIDX)
+11 IF $PIECE(^TMP("DILIST",$JOB,0),U,3)
Begin DoDot:1
+12 SET @RESULTS@(0)="-1^Too many patients found matching '"_DATA_"'. Please be more specific."
End DoDot:1
QUIT
+13 FOR GMV=0:0
SET GMV=$ORDER(^TMP("DILIST",$JOB,GMV))
if 'GMV
QUIT
Begin DoDot:1
+14 SET @RESULTS@(GMV)=$$PTREC(+^TMP("DILIST",$JOB,GMV,0))
End DoDot:1
+15 IF '$DATA(@RESULTS)
SET @RESULTS@(0)="-1^No patients matching '"_DATA_"'"
+16 IF '$TEST
SET @RESULTS@(0)=+$ORDER(@RESULTS@(""),-1)
+17 QUIT
+18 ;
PTREC(DFN) ;
+1 ; Extrinsic to return a Pt Rec in standard list format
+2 NEW GMV
+3 SET GMV=$GET(^DPT(DFN,0))
+4 SET GMV="2;"_DFN_U_$PIECE(GMV,U,1)_U_$PIECE(GMV,U,2)_U_$PIECE(GMV,U,3)_U_$PIECE(GMV,U,9)
+5 SET $PIECE(GMV,U,10)=$$DOB^DPTLK1(DFN)
+6 SET $PIECE(GMV,U,11)=$$SSN^DPTLK1(DFN)
+7 QUIT GMV
+8 ;
SELECT ; [Procedure] Select patient
+1 ; Calls required utilities to check security and
+2 ; return associated warnings/alerts about a
+3 ; patient being selected.
+4 ; Variables:
+5 ; IENS: [Private] Fileman IENS
+6 ; GMVDFN: [Private] Scratch
+7 ; GMVFLD: [Private] FIeld number
+8 ; GMVID: [Private] Identifier array
+9 ; GMVRET: [Private] Scratch
+10 ; GMVX: [Private] Scratch
+11 ; New private variables
+12 NEW IENS,GMVCNT,GMVDFN,GMVFLD,GMVHLIEN,GMVI,GMVID,GMVIDS,GMVRET,GMVX,GMVIDIEN
+13 IF '$DATA(^DPT(+$GET(DFN),0))#2
SET @RESULTS@(0)="-1^No such patient"
QUIT
+14 ;spacebar return
SET ^DISV(DUZ,"^DPT(")=DFN
+15 SET @RESULTS@(0)="1^Required Identifiers & messages"
+16 SET IENS=DFN_","
+17 DO FILE^DID(2,,"REQUIRED IDENTIFIERS","GMVIDS")
+18 FOR GMVX=0:0
SET GMVX=$ORDER(GMVIDS("REQUIRED IDENTIFIERS",GMVX))
if 'GMVX
QUIT
Begin DoDot:1
+19 SET GMVFLD=GMVIDS("REQUIRED IDENTIFIERS",GMVX,"FIELD")
+20 SET GMVID="$$PTID^"_$$GET1^DID(2,GMVFLD,"","LABEL")
+21 SET GMVID=GMVID_U_$$GET1^DIQ(2,IENS,GMVFLD)
+22 if GMVFLD=.03
Begin DoDot:2
+23 SET GMVID=GMVID_" ("_$$GET1^DIQ(2,IENS,.033)_")"
+24 SET GMVID=GMVID_U_$$DOB^DPTLK1(+IENS)
End DoDot:2
+25 if GMVFLD=.09
Begin DoDot:2
+26 SET X=$PIECE(GMVID,U,3)
SET X=$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,10)
+27 SET $PIECE(GMVID,U,3)=X
SET $PIECE(GMVID,U,4)=$$SSN^DPTLK1(+IENS)
End DoDot:2
+28 SET @RESULTS@($ORDER(@RESULTS@(""),-1)+1)=GMVID
End DoDot:1
+29 ; Add ward and Room/Bed
+30 SET GMVID="$$PTID^"_$$GET1^DID(2,.1,"","LABEL")
+31 SET GMVID=GMVID_U_$$GET1^DIQ(2,IENS,.1)
+32 SET GMVIDIEN=$PIECE(GMVID,U,3)
+33 SET GMVIDIEN=$$IDIEN(GMVIDIEN)
+34 SET @RESULTS@($ORDER(@RESULTS@(""),-1)+1)=GMVID
+35 SET GMVID="$$PTID^"_$$GET1^DID(2,.101,"","LABEL")
+36 SET GMVID=GMVID_U_$$GET1^DIQ(2,IENS,.101)
+37 SET @RESULTS@($ORDER(@RESULTS@(""),-1)+1)=GMVID
+38 ; ------- Clevland Alert -------
+39 KILL GMVRET
+40 DO GUIBS5A^DPTLK6(.GMVRET,DFN)
if GMVRET(1)=1
Begin DoDot:1
+41 DO ADD("$$MSGHDR^2^SAME LAST NAME AND LAST 4")
+42 SET GMVX=1
+43 FOR
SET GMVX=$ORDER(GMVRET(GMVX))
if 'GMVX!(+$GET(GMVRET(GMVX)))
QUIT
Begin DoDot:2
+44 DO ADD($PIECE(GMVRET(GMVX),U,2))
End DoDot:2
+45 DO ADD(" ")
+46 SET GMVX=1
+47 FOR
SET GMVX=$ORDER(GMVRET(GMVX))
if 'GMVX
QUIT
if +GMVRET(GMVX)
Begin DoDot:2
+48 SET GMVDFN=+$PIECE(GMVRET(GMVX),U,2)
+49 DO ADD($$GET1^DIQ(2,GMVDFN_",",.01)_" "_$$DOB^DPTLK1(GMVDFN)_" "_$$SSN^DPTLK1(GMVDFN))
End DoDot:2
+50 DO ADD(" ")
+51 DO ADD("Please review carefully before continuing")
+52 DO ADD("$$MSGEND")
End DoDot:1
+53 ; ------- Sensitive Record? -------
+54 KILL GMVRET
+55 DO PTSEC^DGSEC4(.GMVRET,DFN)
if GMVRET(1)'=0
Begin DoDot:1
+56 if GMVRET(1)=3
Begin DoDot:2
+57 DO ADD("$$MSGHDR^0^CAN'T ACCESS YOUR OWN RECORD!!")
End DoDot:2
+58 if GMVRET(1)=-1
Begin DoDot:2
+59 DO ADD("$$MSGHDR^0^INCOMPLETE INFORMATION - CAN'T PROCEED")
End DoDot:2
+60 if GMVRET(1)=1
Begin DoDot:2
+61 DO ADD("$$MSGHDR^1^SENSITIVE RECORD ACCESS")
End DoDot:2
+62 if GMVRET(1)'=-1&(GMVRET(1)'=3)&(GMVRET(1)'=1)
Begin DoDot:2
+63 DO ADD("$$MSGHDR^3^SENSITIVE RECORD ACCESS")
End DoDot:2
+64 SET GMVX=1
+65 FOR
SET GMVX=$ORDER(GMVRET(GMVX))
if 'GMVX
QUIT
DO ADD($TRANSLATE(GMVRET(GMVX),"*"," "))
+66 DO ADD("$$MSGEND")
End DoDot:1
+67 ; ------- Means Test Information? -------
+68 DO GUIMTD^DPTLK6(.GMVRET,DFN)
if GMVRET(1)=1
Begin DoDot:1
+69 DO ADD("$$MSGHDR^1^NOTICE")
+70 FOR GMVX=1:0
SET GMVX=$ORDER(GMVRET(GMVX))
if 'GMVX
QUIT
DO ADD(GMVRET(GMVX))
+71 DO ADD("$$MSGEND")
End DoDot:1
+72 QUIT
+73 ;
IDIEN(GMVIEN) ;
+1 SET GMVIEN=$GET(GMVIEN)
+2 IF GMVIEN=""
QUIT ""
+3 SET GMVIEN=$ORDER(^DIC(42,"B",GMVIEN,0))
+4 IF 'GMVIEN
QUIT ""
+5 SET GMVIEN=$PIECE($GET(^DIC(42,+GMVIEN,44)),"U",1)
+6 QUIT GMVIEN
+7 ;
CCOW ; Return CCOW site and production indicator
+1 SET @RESULTS@(0)=$PIECE($$SITE^VASITE(),"^",3)_"^"_$$PROD^XUPROD()
+2 QUIT
+3 ;
