HMPWBSO ; CNP/JD,MBS - Sign orders RPCs ;08/27/15 12:05
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;August 27, 2015;Build 28
;Per VA Directive 6402, this routine should not be modified.
;
Q
;
; RPC: HMP SIGN ORDERS
SIGN(RSLT,DFN,ORNP,ORL,ES,DATA) ;
;
;Output
; RSLT = 1 on success, 0 otherwise
; RSLT(ORIEN) = error message
;Input
; DFN - patient IEN - ^DPT(
; ORNP - provider IEN - ^VA(200
; ORL - location IEN - ^SC(
; ES - electronic signature
; DATA(ORIEN) = order IEN - ^OR(100
;
N ESOK,ORID,VAL,OK,ORS,IDX,ERR
S U="^",IDX=0,ERR=0,XQY0="OR CPRS GUI CHART"
S RSLT=0
I $D(^DPT(+$G(DFN)))'>1 S RSLT(0)="Invalid DFN - "_+$G(DFN) Q
I $D(^VA(200,+$G(ORNP)))'>1 S RSLT(0)="Invalid ORNP - "_+$G(ORNP) Q
I $D(^SC(+$G(ORL)))'>1 S RSLT(0)="Invalid ORL - "_+$G(ORL) Q
I '$D(^XUSEC("PROVIDER",ORNP)) S RSLT(0)="Not a provider" Q
D VALIDSIG^ORWU(.ESOK,$G(ES)) I $G(ESOK)'>0 S RSLT(0)="Signature not valid" Q
I $D(DATA)'>1 S RSLT(0)="Invalid DATA array" Q
S ORID=0 F S ORID=$O(DATA(ORID)) Q:'ORID D
. D VALID^ORWDXA(.VAL,ORID,"ES",ORNP)
. I $L(VAL)>0 S RSLT(ORID)=ORID_";1"_U_"E"_U_VAL,ERR=1
. D LOCKORD^ORWDX(.OK,ORID)
. I 'OK S RSLT(ORID)=ORID_";1"_U_"E"_U_$P(OK,U,2),ERR=1
. S IDX=IDX+1,ORS(IDX)=ORID_";1^1^1^E"
I ERR S RSLT=0 Q
D SEND^ORWDX(.RSLT,DFN,ORNP,ORL,ES,.ORS)
S ORID=0 F S ORID=$O(DATA(ORID)) Q:'ORID D
. D UNLKORD^ORWDX(.OK,ORID)
S RSLT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPWBSO 1433 printed Apr 09, 2024@20:59:44 Page 2
HMPWBSO ; CNP/JD,MBS - Sign orders RPCs ;08/27/15 12:05
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;August 27, 2015;Build 28
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; RPC: HMP SIGN ORDERS
SIGN(RSLT,DFN,ORNP,ORL,ES,DATA) ;
+1 ;
+2 ;Output
+3 ; RSLT = 1 on success, 0 otherwise
+4 ; RSLT(ORIEN) = error message
+5 ;Input
+6 ; DFN - patient IEN - ^DPT(
+7 ; ORNP - provider IEN - ^VA(200
+8 ; ORL - location IEN - ^SC(
+9 ; ES - electronic signature
+10 ; DATA(ORIEN) = order IEN - ^OR(100
+11 ;
+12 NEW ESOK,ORID,VAL,OK,ORS,IDX,ERR
+13 SET U="^"
SET IDX=0
SET ERR=0
SET XQY0="OR CPRS GUI CHART"
+14 SET RSLT=0
+15 IF $DATA(^DPT(+$GET(DFN)))'>1
SET RSLT(0)="Invalid DFN - "_+$GET(DFN)
QUIT
+16 IF $DATA(^VA(200,+$GET(ORNP)))'>1
SET RSLT(0)="Invalid ORNP - "_+$GET(ORNP)
QUIT
+17 IF $DATA(^SC(+$GET(ORL)))'>1
SET RSLT(0)="Invalid ORL - "_+$GET(ORL)
QUIT
+18 IF '$DATA(^XUSEC("PROVIDER",ORNP))
SET RSLT(0)="Not a provider"
QUIT
+19 DO VALIDSIG^ORWU(.ESOK,$GET(ES))
IF $GET(ESOK)'>0
SET RSLT(0)="Signature not valid"
QUIT
+20 IF $DATA(DATA)'>1
SET RSLT(0)="Invalid DATA array"
QUIT
+21 SET ORID=0
FOR
SET ORID=$ORDER(DATA(ORID))
if 'ORID
QUIT
Begin DoDot:1
+22 DO VALID^ORWDXA(.VAL,ORID,"ES",ORNP)
+23 IF $LENGTH(VAL)>0
SET RSLT(ORID)=ORID_";1"_U_"E"_U_VAL
SET ERR=1
+24 DO LOCKORD^ORWDX(.OK,ORID)
+25 IF 'OK
SET RSLT(ORID)=ORID_";1"_U_"E"_U_$PIECE(OK,U,2)
SET ERR=1
+26 SET IDX=IDX+1
SET ORS(IDX)=ORID_";1^1^1^E"
End DoDot:1
+27 IF ERR
SET RSLT=0
QUIT
+28 DO SEND^ORWDX(.RSLT,DFN,ORNP,ORL,ES,.ORS)
+29 SET ORID=0
FOR
SET ORID=$ORDER(DATA(ORID))
if 'ORID
QUIT
Begin DoDot:1
+30 DO UNLKORD^ORWDX(.OK,ORID)
End DoDot:1
+31 SET RSLT=1
+32 QUIT
