ORRCSIG ;SLC/MKB - Signature utilities for CM ; 25 Jul 2003 9:31 AM
;;1.0;CARE MANAGEMENT;;Jul 15, 2003
;
; ID = "DOC:"_Document# or "ORU:"_Order# everywhere below
;
LIST(ORY,ORUSR,ORPAT,ORDET) ; -- Return unsigned orders and documents by ORUSR for ORPAT
; in @ORY@(#) = Item=ID^Text^Date in HL7 format, and also if ORDET
; = Text=line of report text
; RPC = ORRC UNSIGNED BY PATIENT
N ORN,ORI,ORORD,ORDOC
S ORUSR=+$G(ORUSR),ORPAT=+$G(ORPAT)
D LISTUNS^ORRCOR(.ORORD,ORUSR,ORPAT,$G(ORDET))
D LISTUNS^ORRCTIU(.ORDOC,ORUSR,ORPAT,$G(ORDET))
S ORY=$NA(^TMP($J,"ORRCSIG")),ORN=0 K @ORY
S ORI=0 F S ORI=$O(@ORORD@(ORI)) Q:ORI<1 S ORN=ORN+1,@ORY@(ORN)=@ORORD@(ORI)
S ORI=0 F S ORI=$O(@ORDOC@(ORI)) Q:ORI<1 S ORN=ORN+1,@ORY@(ORN)=@ORDOC@(ORI)
K @ORORD,@ORDOC
Q
;
DETAIL(ORY,ITEM) ; -- Return details of unsigned ITEMs
; where ITEM(#) = ID
; in @ORY@(#) = Item=ID^Text^Date in HL7 format
; = Text=line of report text
; RPC = ORRC UNSIGNED BY ID
N ORN,ORI,ORID,ORO,ORD,ORORD,ORDOC
S ORI="" F S ORI=$O(ITEM(ORI)) Q:ORI="" S ORID=ITEM(ORI) D
. I ORID["OR" S ORO(ORI)=ORID
. I ORID["DOC" S ORD(ORI)=ORID
D DETAIL^ORRCOR(.ORORD,.ORO),TEXT^ORRCTIU(.ORDOC,.ORD)
S ORY=$NA(^TMP($J,"ORRCSIG")),ORN=0 K @ORY
S ORI=0 F S ORI=$O(@ORORD@(ORI)) Q:ORI<1 S ORN=ORN+1,@ORY@(ORN)=@ORORD@(ORI)
S ORI=0 F S ORI=$O(@ORDOC@(ORI)) Q:ORI<1 S ORN=ORN+1,@ORY@(ORN)=@ORDOC@(ORI)
K @ORORD,@ORDOC
Q
;
SIGN(ORY,ORNP,LOC,ESCODE,ITEM) ; -- Apply signature to ITEMs
; where ITEM(#) = ID for notes, or for orders
; = ID^DFN^Release Flag^Signature Status^Nature of Order
; in @ORY@(#) = ID^Success Indicator^Error Message (if 'Success)
; RPC = ORRC SIGN ITEMS
N ORN,DFN,ORID,ORO,ORD,ORORD,ORDOC
S ORI="" F S ORI=$O(ITEM(ORI)) Q:ORI="" D
. S ORID=$P(ITEM(ORI),U)
. I ORID["OR" S ORO(ORI)=$P(ORID,":",2)_U_$P(ITEM(ORI),U,2,5)
. I ORID["DOC" D
. . N ERROR
. . D SIGN^TIUSRVP(.ERROR,$P(ORID,":",2),ESCODE)
. . S ORDOC(ORI)=ORID_U_'+ERROR_$P(ERROR,U,2)
I $D(ORO) D SIGNORDR(.ORORD,ORNP,LOC,.ORO)
S ORY=$NA(^TMP($J,"ORRCSIG")),ORN=0 K @ORY
S ORI=0 F S ORI=$O(ORORD(ORI)) Q:ORI<1 S ORN=ORN+1,@ORY@(ORN)=ORORD(ORI)
S ORI=0 F S ORI=$O(ORDOC(ORI)) Q:ORI<1 S ORN=ORN+1,@ORY@(ORN)=ORDOC(ORI)
Q
SIGNORDR(ORORD,ORNP,LOC,ORO) ; Sign orders
N OROBYPT,DFN,OREI,ORNDX,ORERRS
D SORTORDR(.ORBYPT,.ORO),INDEX(.ORNDX,.ORO,.ORORD)
S DFN=0 F S DFN=$O(ORBYPT(DFN)) Q:+DFN'>0 D
. N ORLST M ORLST=ORBYPT(DFN)
. ;D SIGN^ORWD(.ORERRS,DFN,ORNP,LOC,.ORLST)
S OREI=0 F S OREI=$O(ORERRS(OREI)) Q:+OREI'>0 D
. N ORID,ORI S ORID=$P(ORERRS(OREI),U),ORI=$G(ORNDX(ORID))
. I +ORI S ORORD(ORI)=ORID_U_0_U_$P(ORERRS(OREI),U,2)
Q
TSTSORT ; Test SORTORDR and INDEX calls
N ORO,ORI,ORBYPT,ORNDX,ORORD
S ORO(1)="123^987^1^U^E"
S ORO(3)="176^789^1^U^E"
S ORO(5)="221^987^1^U^E"
S ORO(6)="233^321^1^U^E"
S ORO(9)="311^789^1^U^E"
S ORO(15)="339^321^1^U^E"
;W ! S ORI=0 F S ORI=$O(ORO(ORI)) Q:+ORI'>0 D
;. W !,"ORO(",ORI,")=",ORO(ORI)
;D SORTORDR(.ORBYPT,.ORO),INDEX(.ORNDX,.ORO,.ORORD)
;W ! ZW ORBYPT W ! ZW ORNDX W ! ZW ORORD
Q
SORTORDR(ORBYPT,ORO) ; Sort orders by patient
N ORI S ORI=0
F S ORI=$O(ORO(ORI)) Q:+ORI'>0 D
. N ORDER,DFN,ID S ORDER=ORO(ORI),DFN=$P(ORDER,U,2),ID=$P(ORDER,U)
. S ORBYPT(DFN,ORI)=ID_U_$P(ORDER,U,3,5)
Q
INDEX(ORNDX,ORO,ORORD) ; Index orders
N ORI S ORI=0
F S ORI=$O(ORO(ORI)) Q:+ORI'>0 D
. N ORID S ORID=$P(ORO(ORI),U)
. S ORNDX(ORID)=ORI,ORORD(ORI)=ORID_U_1
Q
ORRCSIG ;SLC/MKB - Signature utilities for CM ; 25 Jul 2003 9:31 AM
+1 ;;1.0;CARE MANAGEMENT;;Jul 15, 2003
+2 ;
+3 ; ID = "DOC:"_Document# or "ORU:"_Order# everywhere below
+4 ;
LIST(ORY,ORUSR,ORPAT,ORDET) ; -- Return unsigned orders and documents by ORUSR for ORPAT
+1 ; in @ORY@(#) = Item=ID^Text^Date in HL7 format, and also if ORDET
+2 ; = Text=line of report text
+3 ; RPC = ORRC UNSIGNED BY PATIENT
+4 NEW ORN,ORI,ORORD,ORDOC
+5 SET ORUSR=+$GET(ORUSR)
SET ORPAT=+$GET(ORPAT)
+6 DO LISTUNS^ORRCOR(.ORORD,ORUSR,ORPAT,$GET(ORDET))
+7 DO LISTUNS^ORRCTIU(.ORDOC,ORUSR,ORPAT,$GET(ORDET))
+8 SET ORY=$NAME(^TMP($JOB,"ORRCSIG"))
SET ORN=0
KILL @ORY
+9 SET ORI=0
FOR
SET ORI=$ORDER(@ORORD@(ORI))
IF ORI<1
QUIT
SET ORN=ORN+1
SET @ORY@(ORN)=@ORORD@(ORI)
+10 SET ORI=0
FOR
SET ORI=$ORDER(@ORDOC@(ORI))
IF ORI<1
QUIT
SET ORN=ORN+1
SET @ORY@(ORN)=@ORDOC@(ORI)
+11 KILL @ORORD,@ORDOC
+12 QUIT
+13 ;
DETAIL(ORY,ITEM) ; -- Return details of unsigned ITEMs
+1 ; where ITEM(#) = ID
+2 ; in @ORY@(#) = Item=ID^Text^Date in HL7 format
+3 ; = Text=line of report text
+4 ; RPC = ORRC UNSIGNED BY ID
+5 NEW ORN,ORI,ORID,ORO,ORD,ORORD,ORDOC
+6 SET ORI=""
FOR
SET ORI=$ORDER(ITEM(ORI))
IF ORI=""
QUIT
SET ORID=ITEM(ORI)
Begin DoDot:1
+7 IF ORID["OR"
SET ORO(ORI)=ORID
+8 IF ORID["DOC"
SET ORD(ORI)=ORID
End DoDot:1
+9 DO DETAIL^ORRCOR(.ORORD,.ORO)
DO TEXT^ORRCTIU(.ORDOC,.ORD)
+10 SET ORY=$NAME(^TMP($JOB,"ORRCSIG"))
SET ORN=0
KILL @ORY
+11 SET ORI=0
FOR
SET ORI=$ORDER(@ORORD@(ORI))
IF ORI<1
QUIT
SET ORN=ORN+1
SET @ORY@(ORN)=@ORORD@(ORI)
+12 SET ORI=0
FOR
SET ORI=$ORDER(@ORDOC@(ORI))
IF ORI<1
QUIT
SET ORN=ORN+1
SET @ORY@(ORN)=@ORDOC@(ORI)
+13 KILL @ORORD,@ORDOC
+14 QUIT
+15 ;
SIGN(ORY,ORNP,LOC,ESCODE,ITEM) ; -- Apply signature to ITEMs
+1 ; where ITEM(#) = ID for notes, or for orders
+2 ; = ID^DFN^Release Flag^Signature Status^Nature of Order
+3 ; in @ORY@(#) = ID^Success Indicator^Error Message (if 'Success)
+4 ; RPC = ORRC SIGN ITEMS
+5 NEW ORN,DFN,ORID,ORO,ORD,ORORD,ORDOC
+6 SET ORI=""
FOR
SET ORI=$ORDER(ITEM(ORI))
IF ORI=""
QUIT
Begin DoDot:1
+7 SET ORID=$PIECE(ITEM(ORI),U)
+8 IF ORID["OR"
SET ORO(ORI)=$PIECE(ORID,":",2)_U_$PIECE(ITEM(ORI),U,2,5)
+9 IF ORID["DOC"
Begin DoDot:2
+10 NEW ERROR
+11 DO SIGN^TIUSRVP(.ERROR,$PIECE(ORID,":",2),ESCODE)
+12 SET ORDOC(ORI)=ORID_U_'+ERROR_$PIECE(ERROR,U,2)
End DoDot:2
End DoDot:1
+13 IF $DATA(ORO)
DO SIGNORDR(.ORORD,ORNP,LOC,.ORO)
+14 SET ORY=$NAME(^TMP($JOB,"ORRCSIG"))
SET ORN=0
KILL @ORY
+15 SET ORI=0
FOR
SET ORI=$ORDER(ORORD(ORI))
IF ORI<1
QUIT
SET ORN=ORN+1
SET @ORY@(ORN)=ORORD(ORI)
+16 SET ORI=0
FOR
SET ORI=$ORDER(ORDOC(ORI))
IF ORI<1
QUIT
SET ORN=ORN+1
SET @ORY@(ORN)=ORDOC(ORI)
+17 QUIT
SIGNORDR(ORORD,ORNP,LOC,ORO) ; Sign orders
+1 NEW OROBYPT,DFN,OREI,ORNDX,ORERRS
+2 DO SORTORDR(.ORBYPT,.ORO)
DO INDEX(.ORNDX,.ORO,.ORORD)
+3 SET DFN=0
FOR
SET DFN=$ORDER(ORBYPT(DFN))
IF +DFN'>0
QUIT
Begin DoDot:1
+4 NEW ORLST
MERGE ORLST=ORBYPT(DFN)
+5 ;D SIGN^ORWD(.ORERRS,DFN,ORNP,LOC,.ORLST)
End DoDot:1
+6 SET OREI=0
FOR
SET OREI=$ORDER(ORERRS(OREI))
IF +OREI'>0
QUIT
Begin DoDot:1
+7 NEW ORID,ORI
SET ORID=$PIECE(ORERRS(OREI),U)
SET ORI=$GET(ORNDX(ORID))
+8 IF +ORI
SET ORORD(ORI)=ORID_U_0_U_$PIECE(ORERRS(OREI),U,2)
End DoDot:1
+9 QUIT
TSTSORT ; Test SORTORDR and INDEX calls
+1 NEW ORO,ORI,ORBYPT,ORNDX,ORORD
+2 SET ORO(1)="123^987^1^U^E"
+3 SET ORO(3)="176^789^1^U^E"
+4 SET ORO(5)="221^987^1^U^E"
+5 SET ORO(6)="233^321^1^U^E"
+6 SET ORO(9)="311^789^1^U^E"
+7 SET ORO(15)="339^321^1^U^E"
+8 ;W ! S ORI=0 F S ORI=$O(ORO(ORI)) Q:+ORI'>0 D
+9 ;. W !,"ORO(",ORI,")=",ORO(ORI)
+10 ;D SORTORDR(.ORBYPT,.ORO),INDEX(.ORNDX,.ORO,.ORORD)
+11 ;W ! ZW ORBYPT W ! ZW ORNDX W ! ZW ORORD
+12 QUIT
SORTORDR(ORBYPT,ORO) ; Sort orders by patient
+1 NEW ORI
SET ORI=0
+2 FOR
SET ORI=$ORDER(ORO(ORI))
IF +ORI'>0
QUIT
Begin DoDot:1
+3 NEW ORDER,DFN,ID
SET ORDER=ORO(ORI)
SET DFN=$PIECE(ORDER,U,2)
SET ID=$PIECE(ORDER,U)
+4 SET ORBYPT(DFN,ORI)=ID_U_$PIECE(ORDER,U,3,5)
End DoDot:1
+5 QUIT
INDEX(ORNDX,ORO,ORORD) ; Index orders
+1 NEW ORI
SET ORI=0
+2 FOR
SET ORI=$ORDER(ORO(ORI))
IF +ORI'>0
QUIT
Begin DoDot:1
+3 NEW ORID
SET ORID=$PIECE(ORO(ORI),U)
+4 SET ORNDX(ORID)=ORI
SET ORORD(ORI)=ORID_U_1
End DoDot:1
+5 QUIT
