- 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