source: WorldVistAEHR/trunk/r/CARE_MANAGEMENT-ORRC/ORRCSIG.m@ 1704

Last change on this file since 1704 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.4 KB
RevLine 
[613]1ORRCSIG ;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 ;
6LIST(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 ;
20DETAIL(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 ;
36SIGN(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
54SIGNORDR(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
64TSTSORT ; 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
77SORTORDR(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
83INDEX(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
Note: See TracBrowser for help on using the repository browser.