| [613] | 1 | ORRCSIG ;SLC/MKB - Signature utilities for CM ; 25 Jul 2003  9:31 AM
 | 
|---|
 | 2 |  ;;1.0;CARE MANAGEMENT;;Jul 15, 2003
 | 
|---|
 | 3 |  ;
 | 
|---|
 | 4 |  ; ID = "DOC:"_Document# or "ORU:"_Order# everywhere below
 | 
|---|
 | 5 |  ;
 | 
|---|
 | 6 | LIST(ORY,ORUSR,ORPAT,ORDET) ; -- Return unsigned orders and documents by ORUSR for ORPAT
 | 
|---|
 | 7 |  ; in @ORY@(#) = Item=ID^Text^Date in HL7 format, and also if ORDET
 | 
|---|
 | 8 |  ;             = Text=line of report text
 | 
|---|
 | 9 |  ; RPC = ORRC UNSIGNED BY PATIENT
 | 
|---|
 | 10 |  N ORN,ORI,ORORD,ORDOC
 | 
|---|
 | 11 |  S ORUSR=+$G(ORUSR),ORPAT=+$G(ORPAT)
 | 
|---|
 | 12 |  D LISTUNS^ORRCOR(.ORORD,ORUSR,ORPAT,$G(ORDET))
 | 
|---|
 | 13 |  D LISTUNS^ORRCTIU(.ORDOC,ORUSR,ORPAT,$G(ORDET))
 | 
|---|
 | 14 |  S ORY=$NA(^TMP($J,"ORRCSIG")),ORN=0 K @ORY
 | 
|---|
 | 15 |  S ORI=0 F  S ORI=$O(@ORORD@(ORI)) Q:ORI<1  S ORN=ORN+1,@ORY@(ORN)=@ORORD@(ORI)
 | 
|---|
 | 16 |  S ORI=0 F  S ORI=$O(@ORDOC@(ORI)) Q:ORI<1  S ORN=ORN+1,@ORY@(ORN)=@ORDOC@(ORI)
 | 
|---|
 | 17 |  K @ORORD,@ORDOC
 | 
|---|
 | 18 |  Q
 | 
|---|
 | 19 |  ;
 | 
|---|
 | 20 | DETAIL(ORY,ITEM) ; -- Return details of unsigned ITEMs
 | 
|---|
 | 21 |  ; where ITEM(#) = ID
 | 
|---|
 | 22 |  ;   in @ORY@(#) = Item=ID^Text^Date in HL7 format
 | 
|---|
 | 23 |  ;               = Text=line of report text
 | 
|---|
 | 24 |  ; RPC = ORRC UNSIGNED BY ID
 | 
|---|
 | 25 |  N ORN,ORI,ORID,ORO,ORD,ORORD,ORDOC
 | 
|---|
 | 26 |  S ORI="" F  S ORI=$O(ITEM(ORI)) Q:ORI=""  S ORID=ITEM(ORI) D
 | 
|---|
 | 27 |  . I ORID["OR" S ORO(ORI)=ORID
 | 
|---|
 | 28 |  . I ORID["DOC" S ORD(ORI)=ORID
 | 
|---|
 | 29 |  D DETAIL^ORRCOR(.ORORD,.ORO),TEXT^ORRCTIU(.ORDOC,.ORD)
 | 
|---|
 | 30 |  S ORY=$NA(^TMP($J,"ORRCSIG")),ORN=0 K @ORY
 | 
|---|
 | 31 |  S ORI=0 F  S ORI=$O(@ORORD@(ORI)) Q:ORI<1  S ORN=ORN+1,@ORY@(ORN)=@ORORD@(ORI)
 | 
|---|
 | 32 |  S ORI=0 F  S ORI=$O(@ORDOC@(ORI)) Q:ORI<1  S ORN=ORN+1,@ORY@(ORN)=@ORDOC@(ORI)
 | 
|---|
 | 33 |  K @ORORD,@ORDOC
 | 
|---|
 | 34 |  Q
 | 
|---|
 | 35 |  ;
 | 
|---|
 | 36 | SIGN(ORY,ORNP,LOC,ESCODE,ITEM) ; -- Apply signature to ITEMs
 | 
|---|
 | 37 |  ; where ITEM(#) = ID for notes, or for orders
 | 
|---|
 | 38 |  ;               = ID^DFN^Release Flag^Signature Status^Nature of Order
 | 
|---|
 | 39 |  ;   in @ORY@(#) = ID^Success Indicator^Error Message (if 'Success)
 | 
|---|
 | 40 |  ; RPC = ORRC SIGN ITEMS
 | 
|---|
 | 41 |  N ORN,DFN,ORID,ORO,ORD,ORORD,ORDOC
 | 
|---|
 | 42 |  S ORI="" F  S ORI=$O(ITEM(ORI)) Q:ORI=""  D
 | 
|---|
 | 43 |  . S ORID=$P(ITEM(ORI),U)
 | 
|---|
 | 44 |  . I ORID["OR" S ORO(ORI)=$P(ORID,":",2)_U_$P(ITEM(ORI),U,2,5)
 | 
|---|
 | 45 |  . I ORID["DOC" D
 | 
|---|
 | 46 |  . . N ERROR
 | 
|---|
 | 47 |  . . D SIGN^TIUSRVP(.ERROR,$P(ORID,":",2),ESCODE)
 | 
|---|
 | 48 |  . . S ORDOC(ORI)=ORID_U_'+ERROR_$P(ERROR,U,2)
 | 
|---|
 | 49 |  I $D(ORO) D SIGNORDR(.ORORD,ORNP,LOC,.ORO)
 | 
|---|
 | 50 |  S ORY=$NA(^TMP($J,"ORRCSIG")),ORN=0 K @ORY
 | 
|---|
 | 51 |  S ORI=0 F  S ORI=$O(ORORD(ORI)) Q:ORI<1  S ORN=ORN+1,@ORY@(ORN)=ORORD(ORI)
 | 
|---|
 | 52 |  S ORI=0 F  S ORI=$O(ORDOC(ORI)) Q:ORI<1  S ORN=ORN+1,@ORY@(ORN)=ORDOC(ORI)
 | 
|---|
 | 53 |  Q
 | 
|---|
 | 54 | SIGNORDR(ORORD,ORNP,LOC,ORO)    ; Sign orders
 | 
|---|
 | 55 |  N OROBYPT,DFN,OREI,ORNDX,ORERRS
 | 
|---|
 | 56 |  D SORTORDR(.ORBYPT,.ORO),INDEX(.ORNDX,.ORO,.ORORD)
 | 
|---|
 | 57 |  S DFN=0 F  S DFN=$O(ORBYPT(DFN)) Q:+DFN'>0  D
 | 
|---|
 | 58 |  . N ORLST M ORLST=ORBYPT(DFN)
 | 
|---|
 | 59 |  . ;D SIGN^ORWD(.ORERRS,DFN,ORNP,LOC,.ORLST)
 | 
|---|
 | 60 |  S OREI=0 F  S OREI=$O(ORERRS(OREI)) Q:+OREI'>0  D
 | 
|---|
 | 61 |  . N ORID,ORI S ORID=$P(ORERRS(OREI),U),ORI=$G(ORNDX(ORID))
 | 
|---|
 | 62 |  . I +ORI S ORORD(ORI)=ORID_U_0_U_$P(ORERRS(OREI),U,2)
 | 
|---|
 | 63 |  Q
 | 
|---|
 | 64 | TSTSORT ; Test SORTORDR and INDEX calls
 | 
|---|
 | 65 |  N ORO,ORI,ORBYPT,ORNDX,ORORD
 | 
|---|
 | 66 |  S ORO(1)="123^987^1^U^E"
 | 
|---|
 | 67 |  S ORO(3)="176^789^1^U^E"
 | 
|---|
 | 68 |  S ORO(5)="221^987^1^U^E"
 | 
|---|
 | 69 |  S ORO(6)="233^321^1^U^E"
 | 
|---|
 | 70 |  S ORO(9)="311^789^1^U^E"
 | 
|---|
 | 71 |  S ORO(15)="339^321^1^U^E"
 | 
|---|
 | 72 |  ;W ! S ORI=0 F  S ORI=$O(ORO(ORI)) Q:+ORI'>0  D
 | 
|---|
 | 73 |  ;. W !,"ORO(",ORI,")=",ORO(ORI)
 | 
|---|
 | 74 |  ;D SORTORDR(.ORBYPT,.ORO),INDEX(.ORNDX,.ORO,.ORORD)
 | 
|---|
 | 75 |  ;W ! ZW ORBYPT W ! ZW ORNDX W ! ZW ORORD
 | 
|---|
 | 76 |  Q
 | 
|---|
 | 77 | SORTORDR(ORBYPT,ORO)    ; Sort orders by patient
 | 
|---|
 | 78 |  N ORI S ORI=0
 | 
|---|
 | 79 |  F  S ORI=$O(ORO(ORI)) Q:+ORI'>0  D
 | 
|---|
 | 80 |  . N ORDER,DFN,ID S ORDER=ORO(ORI),DFN=$P(ORDER,U,2),ID=$P(ORDER,U)
 | 
|---|
 | 81 |  . S ORBYPT(DFN,ORI)=ID_U_$P(ORDER,U,3,5)
 | 
|---|
 | 82 |  Q
 | 
|---|
 | 83 | INDEX(ORNDX,ORO,ORORD)  ; Index orders
 | 
|---|
 | 84 |  N ORI S ORI=0
 | 
|---|
 | 85 |  F  S ORI=$O(ORO(ORI)) Q:+ORI'>0  D
 | 
|---|
 | 86 |  . N ORID S ORID=$P(ORO(ORI),U)
 | 
|---|
 | 87 |  . S ORNDX(ORID)=ORI,ORORD(ORI)=ORID_U_1
 | 
|---|
 | 88 |  Q
 | 
|---|