ORRCTSK.m

ORRCTSK ;SLC/MKB -- Patient Task file #102.3 utilities ; 25 Jul 2003  9:31 AM

 ;;1.0;CARE MANAGEMENT;;Jul 15, 2003

 ;

 ; ID = "TSK:"_task# everywhere below

 ;

PATS(ORY,ORUSR) ; -- Return list of patients for whom ORUSR has tasks due

 ; in @ORY@(PAT) = #tasks ^ 1 if any are high priority

 ;    @ORY@(PAT,ID) = * if high priority, else null

 ; [from ORRCDPT]

 N ORPROV,DUE,PAT,CNT,ABN,IFN,X0

 S ORY=$NA(^TMP($J,"ORRCTSK")) K @ORY

 S ORUSR=+$G(ORUSR),DUE=$S($G(DT):DT,1:$P($$NOW^XLFDT,"."))

 S PAT=0 F  S PAT=+$O(^ORRT(102.3,"DUE",PAT)) Q:PAT<1  D

 . I $D(^TMP($J,"ORRCLST")),'$D(^TMP($J,"ORRCY",PAT)) Q  ;pt not on list

 . S ORPROV=$$PROV(ORUSR,PAT),(CNT,ABN,IFN)=0

 . F  S IFN=+$O(^ORRT(102.3,"DUE",PAT,IFN)) Q:IFN<1  D

 .. S X0=$G(^ORRT(102.3,IFN,0)) I $P(X0,U,5),$P($P(X0,U,5),".")>DUE Q

 .. I $P(X0,U,2)'=+ORUSR,'ORPROV Q  ;not linked provider

 .. S @ORY@(PAT,"TSK:"_IFN)=$S($P(X0,U,4)="H":"*",1:"")

 .. S CNT=CNT+1 S:$P(X0,U,4)="H" ABN=1

 . I CNT S @ORY@(PAT)=CNT_U_ABN

 Q

 ;

IDS(ORY,PAT) ; -- Return due tasks for PAT

 ; in @ORY@(PAT) = #tasks ^ 1 if any are high priority

 ;    @ORY@(PAT,ID) = * if high priority, else null

 ; [from ORRCDPT1]

 N DUE,CNT,ABN,IFN,X0

 S ORY=$NA(^TMP($J,"ORRCTSK")) K @ORY

 S DUE=$S($G(DT):DT,1:$P($$NOW^XLFDT,".")),CNT=0,ABN=""

 S IFN=0 F  S IFN=+$O(^ORRT(102.3,"DUE",PAT,IFN)) Q:IFN<1  D

 . S X0=$G(^ORRT(102.3,IFN,0)) I $P(X0,U,5),$P($P(X0,U,5),".")>DUE Q

 . S @ORY@(PAT,"TSK:"_IFN)=$S($P(X0,U,4)="H":"*",1:"")

 . S CNT=CNT+1 S:$P(X0,U,4)="H" ABN=1

 S:CNT @ORY@(PAT)=CNT_U_ABN

 Q

 ;

PROV(USR,PAT) ; -- Return 1 or 0, if USR is a provider for PAT

 N Y,LIST S Y=0 S USR=+$G(USR),PAT=+$G(PAT)

 I +$G(^DPT(PAT,.104))=USR S Y=1 G PVQ ;Prim Prov

 I +$G(^DPT(PAT,.1041))=USR S Y=1 G PVQ ;Attending Prov

 S PAT=PAT_";DPT(",LIST=0

 F  S LIST=+$O(^OR(100.21,"AB",PAT,LIST)) Q:LIST<1  I $G(^OR(100.21,LIST,1,USR,0)) S Y=1 Q

PVQ Q Y

 ;

LIST(ORY,ORPAT,ORUSR,ORDUE) ; -- Return incomplete[ORDUE] tasks [by ORUSR] for ORPAT

 ; in ORY(#) = ID^subject^date created^who created^patient^priority^due^date completed^who completed^date canceled^who canceled^items

 ; RPC = ORRC TASKS BY PATIENT

 N ORN,ORPROV,IFN,X0,X1,I,ITMS,X K ORY

 S ORN=0,ORPAT=+$G(ORPAT),ORPROV=$S($G(ORUSR):$$PROV(ORUSR,ORPAT),1:"")

 I $G(ORDUE) S ORDUE=$$HL7TFM^XLFDT(ORDUE)

 S IFN=0 F  S IFN=+$O(^ORRT(102.3,"DUE",ORPAT,IFN)) Q:IFN<1  D

 . S X0=$G(^ORRT(102.3,IFN,0)),X1=$G(^(1)),ITMS=""

 . I $G(ORDUE),$P(X0,U,5),$P($P(X0,U,5),".")>ORDUE Q  ;future-not due yet

 . I $G(ORUSR),$P(X0,U,2)'=+ORUSR,'ORPROV Q  ;not linked prov

 . F I=1,5,6,8 S X=$P(X0,U,I) I $L(X) S $P(X0,U,I)=$$FMTHL7^XLFDT(X)

 . S I=0 F  S I=$O(^ORRT(102.3,IFN,2,I)) Q:I<1  S X=$G(^(I,0)),ITMS=ITMS_$S($L(ITMS):"~",1:"")_X

 . S $P(X0,U,10)=ITMS,ORN=ORN+1,ORY(ORN)="TSK:"_IFN_U_X1_U_X0

 Q

 ;

DUE(ORY,ORPAT) ; -- Return tasks that are due for ORPAT

 ; in ORY(#) = ID^subject^date created^who created^patient^priority^due^date completed^who completed^date canceled^who canceled^items

 ; RPC = ORRC TASKS DUE BY PATIENT <not used>

 N ORDT S ORDT=$$FMTHL7^XLFDT($G(DT))

 D LIST(.ORY,ORPAT,,ORDT)

 Q

 ;

DETAIL(ORY,TASK) ; -- Return details of TASKs

 ; where TASK(#) = ID

 ; in ORY(#) = ID^subject^date created^who created^patient^priority^due^date completed^who completed^date canceled^who canceled^items

 ; RPC = ORRC TASKS BY ID

 N ORN,ORI,ID,IFN,X0,X1,ITMS,I,X S ORN=0 K ORY

 S ORI="" F  S ORI=$O(TASK(ORI)) Q:ORI=""  S ID=$G(TASK(ORI)) D

 . S IFN=+$P(ID,":",2),X0=$G(^ORRT(102.3,IFN,0)),X1=$G(^(1))

 . F I=1,5,6,8 S X=$P(X0,U,I) I $L(X) S $P(X0,U,I)=$$FMTHL7^XLFDT(X)

 . S ITMS="",I=0 F  S I=$O(^ORRT(102.3,IFN,2,I)) Q:I<1  S X=$G(^(I,0)),ITMS=ITMS_$S($L(ITMS):"~",1:"")_X

 . S $P(X0,U,10)=ITMS,ORN=ORN+1,ORY(ORN)=ID_U_X1_U_X0

 Q

 ;

NEW(ORY,DATA) ; -- Create new task

 ;   where DATA = [^]subject^date created^user^patient^priority^due^date completed^who completed^date canceled^who canceled^items

 ; returns ORY  = ID if successful, else 0^error message

 ; RPC = ORRC TASK ADD

 N DO,DIC,X,Y,I,ITMS S ORY=""

 I '$L($G(DATA)) S ORY="0^Missing data string" Q

 S DATA=U_DATA,ORY=$$VALID(.DATA) Q:'ORY  ;invalid data

 S DIC="^ORRT(102.3,",DIC(0)="",X=$P(DATA,U,3) S:X<1 X=$$NOW^XLFDT

 D FILE^DICN I Y<1 S ORY="0^Unable to create new task" Q

 S $P(^ORRT(102.3,+Y,0),U,2,9)=$P(DATA,U,4,11),^(1)=$P(DATA,U,2)

 S ^ORRT(102.3,"C",+$P(DATA,U,5),+Y)=""

 I '$P(DATA,U,8),'$P(DATA,U,10) S ^ORRT(102.3,"DUE",+$P(DATA,U,5),+Y)=""

 S ITMS=$P(DATA,U,12) I $L(ITMS) D

 . F I=1:1:$L(ITMS,"~") S X=$P(ITMS,"~",I) I $L(X) S ^ORRT(102.3,+Y,2,I,0)=X,^ORRT(102.3,+Y,2,"B",X,I)=""

 . S ^ORRT(102.3,+Y,2,0)="^102.31AV^"_I_U_I

 S ORY="TSK:"_+Y

 Q

 ;

VALID(DATA) ; -- Returns 1 or 0^error if DATA string is valid

 N X,Y,I,L S Y=1

 S X=$P(DATA,U) I $L(X),'$D(^ORRT(102.3,+$P(X,":",2),0)) S Y="0^Invalid task number" G VQ

 S X=$P(DATA,U,5) I X'=+X!(X<1)!'$D(^DPT(+X,0)) S Y="0^Missing or invalid patient ID" G VQ

 F I=4,9 S X=$P(X,U,I) I $L(X),X'=+X!(X<1)!'$D(^VA(200,+X,0)) S Y="0^Missing or invalid user ID" G VQ

 F I=3,7,8,10 S X=$P(DATA,U,I) I $L(X) D  Q:'Y

 . I $L(X)=12,$E(X,9,12)="0000" S X=$E(X,1,8) ;date only

 . S X=$$HL7TFM^XLFDT(X) I $L(X) S $P(DATA,U,I)=X Q  ;reformat

 . S Y="0^Invalid date "_$S(I=3:"created",I=7:"due",1:"completed")

 S X=$P(DATA,U,6) I $L(X),X'="L",X'="M",X'="H" S Y="0^Invalid priority" G VQ

 S X=$P(DATA,U,2) I '$L(X)!(X["^")!($L(X)>100) S Y="0^Invalid subject text" G VQ

 S X=$P(DATA,U,12) I $L(X) F I=1:1:$P(X,"~") S L=$P(X,"~",I) I $L(L),L'?3U1":".E S Y="0^Invalid linked item ID" Q

VQ Q Y

 ;

EDIT(ORY,TASK) ; -- Change existing tasks

 ;   where TASK(#) = ID^subject^date created^user^patient^priority^due^date completed^who completed^date canceled^who canceled^items

 ; returns ORY(#)  = ID^1 or ID^0^error, if successful or not

 ; RPC = ORRC TASK EDIT

 N ORI,DATA,ID,DA,I,X,Y,SUBJ,ITMS,X0 K ORY

 S ORI="" F  S ORI=$O(TASK(ORI)) Q:ORI=""  S DATA=$G(TASK(ORI)) D

 . S ID=$P(DATA,U),DA=+$P(ID,":",2)

 . I DA<1 S ORY(ORI)=ID_"^0^Invalid task number" Q

 . S X=$$VALID(.DATA) I X<1 S ORY(ORI)=ID_U_X Q

 . L +^ORRT(102.3,DA):5 I '$T S ORY(ORI)=ID_"^0^Another user is editing this task" Q

 . S SUBJ=$P(DATA,U,2),ITMS=$P(DATA,U,12),DATA=$P(DATA,U,3,11)

 . S X0=$G(^ORRT(102.3,DA,0)),^(0)=DATA,^(1)=SUBJ K ^(2) I $L(ITMS) D

 .. F I=1:1:$L(ITMS,"~") S X=$P(ITMS,"~",I) I $L(X) S ^ORRT(102.3,DA,2,I,0)=X,^ORRT(102.3,DA,2,"B",X,I)=""

 .. S ^ORRT(102.3,DA,2,0)="^102.31AV^"_I_U_I

 . I $P(X0,U)'=$P(DATA,U) K ^ORRT(102.3,"B",$P(X0,U),DA) S ^ORRT(102.3,"B",$P(DATA,U),DA)=""

 . I $P(X0,U,3)'=$P(DATA,U,3) K ^ORRT(102.3,"C",$P(X0,U,3),DA) S ^ORRT(102.3,"C",$P(DATA,U,3),DA)=""

 . K ^ORRT(102.3,"DUE",$P(X0,U,3),DA)

 . I '$P(DATA,U,6),'$P(DATA,U,8) S ^ORRT(102.3,"DUE",$P(DATA,U,3),DA)=""

 . S ORY(ORI)=ID_"^1" L -^ORRT(102.3,DA)

 Q

 ;

COMP(ORY,ORUSR,TASK) ; -- Complete tasks by ORUSR

 ;   where TASK(#) = ID

 ; returns ORY(#)  = ID^1 or ID^0^error, if successful or not

 ; RPC = ORRC TASK COMPLETE

 N X,Y,ID,DA,DR,DIE,ORI

 I $G(ORUSR)<1 S ORY(0)="0^Invalid user identifier" Q

 S DIE="^ORRT(102.3,",DR="6///NOW;7///"_+ORUSR

 S ORI="" F  S ORI=$O(TASK(ORI)) Q:ORI=""  S ID=TASK(ORI) D

 . S DA=+$P(ID,":",2) I DA<1 S ORY(ORI)=ID_"^0^Invalid task number" Q

 . L +^ORRT(102.3,DA):5 I '$T S ORY(ORI)=ID_"^0^Another user is editing this task" Q

 . D ^DIE S ORY(ORI)=ID_"^1" L -^ORRT(102.3,DA)

 Q

 ;

CANC(ORY,ORUSR,TASK) ; -- Cancel tasks by ORUSR

 ;   where TASK(#) = ID

 ; returns ORY(#)  = ID^1 or ID^0^error, if successful or not

 ; RPC = ORRC TASK CANCEL

 N X,Y,ID,DA,DR,DIE,ORI

 I $G(ORUSR)<1 S ORY(0)="0^Invalid user identifier" Q

 S DIE="^ORRT(102.3,",DR="8///NOW;9///"_+ORUSR

 S ORI="" F  S ORI=$O(TASK(ORI)) Q:ORI=""  S ID=TASK(ORI) D

 . S DA=+$P(ID,":",2) I DA<1 S ORY(ORI)=ID_"^0^Invalid task number" Q

 . L +^ORRT(102.3,DA):5 I '$T S ORY(ORI)=ID_"^0^Another user is editing this task" Q

 . D ^DIE S ORY(ORI)=ID_"^1" L -^ORRT(102.3,DA)

 Q

 ;

SUBJ(ORY,ORPAT) ; -- Return list of task subjects used for ORPAT

 ; as ORY(#) = task subject

 N ORI,ORN K ORY S ORN=0

 S ORI=0  F  S ORI=$O(^ORRT(102.3,"C",ORPAT,ORI)) Q:ORI<1  D

 . S X=$G(^ORRT(102.3,ORI,1)) Q:'$L(X)

 . S ORN=ORN+1,ORY(ORN)=X

 Q

ORRCTSK   ;SLC/MKB -- Patient Task file #102.3 utilities ; 25 Jul 2003  9:31 AM

 +1       ;;1.0;CARE MANAGEMENT;;Jul 15, 2003

 +2       ;

 +3       ; ID = "TSK:"_task# everywhere below

 +4       ;

PATS(ORY,ORUSR) ; -- Return list of patients for whom ORUSR has tasks due

 +1       ; in @ORY@(PAT) = #tasks ^ 1 if any are high priority

 +2       ;    @ORY@(PAT,ID) = * if high priority, else null

 +3       ; [from ORRCDPT]

 +4        NEW ORPROV,DUE,PAT,CNT,ABN,IFN,X0

 +5        SET ORY=$NAME(^TMP($JOB,"ORRCTSK"))

           KILL @ORY

 +6        SET ORUSR=+$GET(ORUSR)

           SET DUE=$SELECT($GET(DT):DT,1:$PIECE($$NOW^XLFDT,"."))

 +7        SET PAT=0

           FOR 

               SET PAT=+$ORDER(^ORRT(102.3,"DUE",PAT))

               IF PAT<1

                   QUIT 

               Begin DoDot:1

 +8       ;pt not on list

                   IF $DATA(^TMP($JOB,"ORRCLST"))

                       IF '$DATA(^TMP($JOB,"ORRCY",PAT))

                           QUIT 

 +9                SET ORPROV=$$PROV(ORUSR,PAT)

                   SET (CNT,ABN,IFN)=0

 +10               FOR 

                       SET IFN=+$ORDER(^ORRT(102.3,"DUE",PAT,IFN))

                       IF IFN<1

                           QUIT 

                       Begin DoDot:2

 +11                       SET X0=$GET(^ORRT(102.3,IFN,0))

                           IF $PIECE(X0,U,5)

                               IF $PIECE($PIECE(X0,U,5),".")>DUE

                                   QUIT 

 +12      ;not linked provider

                           IF $PIECE(X0,U,2)'=+ORUSR

                               IF 'ORPROV

                                   QUIT 

 +13                       SET @ORY@(PAT,"TSK:"_IFN)=$SELECT($PIECE(X0,U,4)="H":"*",1:"")

 +14                       SET CNT=CNT+1

                           IF $PIECE(X0,U,4)="H"

                               SET ABN=1

                       End DoDot:2

 +15               IF CNT

                       SET @ORY@(PAT)=CNT_U_ABN

               End DoDot:1

 +16       QUIT 

 +17      ;

IDS(ORY,PAT) ; -- Return due tasks for PAT

 +1       ; in @ORY@(PAT) = #tasks ^ 1 if any are high priority

 +2       ;    @ORY@(PAT,ID) = * if high priority, else null

 +3       ; [from ORRCDPT1]

 +4        NEW DUE,CNT,ABN,IFN,X0

 +5        SET ORY=$NAME(^TMP($JOB,"ORRCTSK"))

           KILL @ORY

 +6        SET DUE=$SELECT($GET(DT):DT,1:$PIECE($$NOW^XLFDT,"."))

           SET CNT=0

           SET ABN=""

 +7        SET IFN=0

           FOR 

               SET IFN=+$ORDER(^ORRT(102.3,"DUE",PAT,IFN))

               IF IFN<1

                   QUIT 

               Begin DoDot:1

 +8                SET X0=$GET(^ORRT(102.3,IFN,0))

                   IF $PIECE(X0,U,5)

                       IF $PIECE($PIECE(X0,U,5),".")>DUE

                           QUIT 

 +9                SET @ORY@(PAT,"TSK:"_IFN)=$SELECT($PIECE(X0,U,4)="H":"*",1:"")

 +10               SET CNT=CNT+1

                   IF $PIECE(X0,U,4)="H"

                       SET ABN=1

               End DoDot:1

 +11       IF CNT

               SET @ORY@(PAT)=CNT_U_ABN

 +12       QUIT 

 +13      ;

PROV(USR,PAT) ; -- Return 1 or 0, if USR is a provider for PAT

 +1        NEW Y,LIST

           SET Y=0

           SET USR=+$GET(USR)

           SET PAT=+$GET(PAT)

 +2       ;Prim Prov

           IF +$GET(^DPT(PAT,.104))=USR

               SET Y=1

               GOTO PVQ

 +3       ;Attending Prov

           IF +$GET(^DPT(PAT,.1041))=USR

               SET Y=1

               GOTO PVQ

 +4        SET PAT=PAT_";DPT("

           SET LIST=0

 +5        FOR 

               SET LIST=+$ORDER(^OR(100.21,"AB",PAT,LIST))

               IF LIST<1

                   QUIT 

               IF $GET(^OR(100.21,LIST,1,USR,0))

                   SET Y=1

                   QUIT 

PVQ        QUIT Y

 +1       ;

LIST(ORY,ORPAT,ORUSR,ORDUE) ; -- Return incomplete[ORDUE] tasks [by ORUSR] for ORPAT

 +1       ; in ORY(#) = ID^subject^date created^who created^patient^priority^due^date completed^who completed^date canceled^who canceled^items

 +2       ; RPC = ORRC TASKS BY PATIENT

 +3        NEW ORN,ORPROV,IFN,X0,X1,I,ITMS,X

           KILL ORY

 +4        SET ORN=0

           SET ORPAT=+$GET(ORPAT)

           SET ORPROV=$SELECT($GET(ORUSR):$$PROV(ORUSR,ORPAT),1:"")

 +5        IF $GET(ORDUE)

               SET ORDUE=$$HL7TFM^XLFDT(ORDUE)

 +6        SET IFN=0

           FOR 

               SET IFN=+$ORDER(^ORRT(102.3,"DUE",ORPAT,IFN))

               IF IFN<1

                   QUIT 

               Begin DoDot:1

 +7                SET X0=$GET(^ORRT(102.3,IFN,0))

                   SET X1=$GET(^(1))

                   SET ITMS=""

 +8       ;future-not due yet

                   IF $GET(ORDUE)

                       IF $PIECE(X0,U,5)

                           IF $PIECE($PIECE(X0,U,5),".")>ORDUE

                               QUIT 

 +9       ;not linked prov

                   IF $GET(ORUSR)

                       IF $PIECE(X0,U,2)'=+ORUSR

                           IF 'ORPROV

                               QUIT 

 +10               FOR I=1,5,6,8

                       SET X=$PIECE(X0,U,I)

                       IF $LENGTH(X)

                           SET $PIECE(X0,U,I)=$$FMTHL7^XLFDT(X)

 +11               SET I=0

                   FOR 

                       SET I=$ORDER(^ORRT(102.3,IFN,2,I))

                       IF I<1

                           QUIT 

                       SET X=$GET(^(I,0))

                       SET ITMS=ITMS_$SELECT($LENGTH(ITMS):"~",1:"")_X

 +12               SET $PIECE(X0,U,10)=ITMS

                   SET ORN=ORN+1

                   SET ORY(ORN)="TSK:"_IFN_U_X1_U_X0

               End DoDot:1

 +13       QUIT 

 +14      ;

DUE(ORY,ORPAT) ; -- Return tasks that are due for ORPAT

 +1       ; in ORY(#) = ID^subject^date created^who created^patient^priority^due^date completed^who completed^date canceled^who canceled^items

 +2       ; RPC = ORRC TASKS DUE BY PATIENT <not used>

 +3        NEW ORDT

           SET ORDT=$$FMTHL7^XLFDT($GET(DT))

 +4        DO LIST(.ORY,ORPAT,,ORDT)

 +5        QUIT 

 +6       ;

DETAIL(ORY,TASK) ; -- Return details of TASKs

 +1       ; where TASK(#) = ID

 +2       ; in ORY(#) = ID^subject^date created^who created^patient^priority^due^date completed^who completed^date canceled^who canceled^items

 +3       ; RPC = ORRC TASKS BY ID

 +4        NEW ORN,ORI,ID,IFN,X0,X1,ITMS,I,X

           SET ORN=0

           KILL ORY

 +5        SET ORI=""

           FOR 

               SET ORI=$ORDER(TASK(ORI))

               IF ORI=""

                   QUIT 

               SET ID=$GET(TASK(ORI))

               Begin DoDot:1

 +6                SET IFN=+$PIECE(ID,":",2)

                   SET X0=$GET(^ORRT(102.3,IFN,0))

                   SET X1=$GET(^(1))

 +7                FOR I=1,5,6,8

                       SET X=$PIECE(X0,U,I)

                       IF $LENGTH(X)

                           SET $PIECE(X0,U,I)=$$FMTHL7^XLFDT(X)

 +8                SET ITMS=""

                   SET I=0

                   FOR 

                       SET I=$ORDER(^ORRT(102.3,IFN,2,I))

                       IF I<1

                           QUIT 

                       SET X=$GET(^(I,0))

                       SET ITMS=ITMS_$SELECT($LENGTH(ITMS):"~",1:"")_X

 +9                SET $PIECE(X0,U,10)=ITMS

                   SET ORN=ORN+1

                   SET ORY(ORN)=ID_U_X1_U_X0

               End DoDot:1

 +10       QUIT 

 +11      ;

NEW(ORY,DATA) ; -- Create new task

 +1       ;   where DATA = [^]subject^date created^user^patient^priority^due^date completed^who completed^date canceled^who canceled^items

 +2       ; returns ORY  = ID if successful, else 0^error message

 +3       ; RPC = ORRC TASK ADD

 +4        NEW DO,DIC,X,Y,I,ITMS

           SET ORY=""

 +5        IF '$LENGTH($GET(DATA))

               SET ORY="0^Missing data string"

               QUIT 

 +6       ;invalid data

           SET DATA=U_DATA

           SET ORY=$$VALID(.DATA)

           IF 'ORY

               QUIT 

 +7        SET DIC="^ORRT(102.3,"

           SET DIC(0)=""

           SET X=$PIECE(DATA,U,3)

           IF X<1

               SET X=$$NOW^XLFDT

 +8        DO FILE^DICN

           IF Y<1

               SET ORY="0^Unable to create new task"

               QUIT 

 +9        SET $PIECE(^ORRT(102.3,+Y,0),U,2,9)=$PIECE(DATA,U,4,11)

           SET ^(1)=$PIECE(DATA,U,2)

 +10       SET ^ORRT(102.3,"C",+$PIECE(DATA,U,5),+Y)=""

 +11       IF '$PIECE(DATA,U,8)

               IF '$PIECE(DATA,U,10)

                   SET ^ORRT(102.3,"DUE",+$PIECE(DATA,U,5),+Y)=""

 +12       SET ITMS=$PIECE(DATA,U,12)

           IF $LENGTH(ITMS)

               Begin DoDot:1

 +13               FOR I=1:1:$LENGTH(ITMS,"~")

                       SET X=$PIECE(ITMS,"~",I)

                       IF $LENGTH(X)

                           SET ^ORRT(102.3,+Y,2,I,0)=X

                           SET ^ORRT(102.3,+Y,2,"B",X,I)=""

 +14               SET ^ORRT(102.3,+Y,2,0)="^102.31AV^"_I_U_I

               End DoDot:1

 +15       SET ORY="TSK:"_+Y

 +16       QUIT 

 +17      ;

VALID(DATA) ; -- Returns 1 or 0^error if DATA string is valid

 +1        NEW X,Y,I,L

           SET Y=1

 +2        SET X=$PIECE(DATA,U)

           IF $LENGTH(X)

               IF '$DATA(^ORRT(102.3,+$PIECE(X,":",2),0))

                   SET Y="0^Invalid task number"

                   GOTO VQ

 +3        SET X=$PIECE(DATA,U,5)

           IF X'=+X!(X<1)!'$DATA(^DPT(+X,0))

               SET Y="0^Missing or invalid patient ID"

               GOTO VQ

 +4        FOR I=4,9

               SET X=$PIECE(X,U,I)

               IF $LENGTH(X)

                   IF X'=+X!(X<1)!'$DATA(^VA(200,+X,0))

                       SET Y="0^Missing or invalid user ID"

                       GOTO VQ

 +5        FOR I=3,7,8,10

               SET X=$PIECE(DATA,U,I)

               IF $LENGTH(X)

                   Begin DoDot:1

 +6       ;date only

                       IF $LENGTH(X)=12

                           IF $EXTRACT(X,9,12)="0000"

                               SET X=$EXTRACT(X,1,8)

 +7       ;reformat

                       SET X=$$HL7TFM^XLFDT(X)

                       IF $LENGTH(X)

                           SET $PIECE(DATA,U,I)=X

                           QUIT 

 +8                    SET Y="0^Invalid date "_$SELECT(I=3:"created",I=7:"due",1:"completed")

                   End DoDot:1

                   IF 'Y

                       QUIT 

 +9        SET X=$PIECE(DATA,U,6)

           IF $LENGTH(X)

               IF X'="L"

                   IF X'="M"

                       IF X'="H"

                           SET Y="0^Invalid priority"

                           GOTO VQ

 +10       SET X=$PIECE(DATA,U,2)

           IF '$LENGTH(X)!(X["^")!($LENGTH(X)>100)

               SET Y="0^Invalid subject text"

               GOTO VQ

 +11       SET X=$PIECE(DATA,U,12)

           IF $LENGTH(X)

               FOR I=1:1:$PIECE(X,"~")

                   SET L=$PIECE(X,"~",I)

                   IF $LENGTH(L)

                       IF L'?3U1":".E

                           SET Y="0^Invalid linked item ID"

                           QUIT 

VQ         QUIT Y

 +1       ;

EDIT(ORY,TASK) ; -- Change existing tasks

 +1       ;   where TASK(#) = ID^subject^date created^user^patient^priority^due^date completed^who completed^date canceled^who canceled^items

 +2       ; returns ORY(#)  = ID^1 or ID^0^error, if successful or not

 +3       ; RPC = ORRC TASK EDIT

 +4        NEW ORI,DATA,ID,DA,I,X,Y,SUBJ,ITMS,X0

           KILL ORY

 +5        SET ORI=""

           FOR 

               SET ORI=$ORDER(TASK(ORI))

               IF ORI=""

                   QUIT 

               SET DATA=$GET(TASK(ORI))

               Begin DoDot:1

 +6                SET ID=$PIECE(DATA,U)

                   SET DA=+$PIECE(ID,":",2)

 +7                IF DA<1

                       SET ORY(ORI)=ID_"^0^Invalid task number"

                       QUIT 

 +8                SET X=$$VALID(.DATA)

                   IF X<1

                       SET ORY(ORI)=ID_U_X

                       QUIT 

 +9                LOCK +^ORRT(102.3,DA):5

                   IF '$TEST

                       SET ORY(ORI)=ID_"^0^Another user is editing this task"

                       QUIT 

 +10               SET SUBJ=$PIECE(DATA,U,2)

                   SET ITMS=$PIECE(DATA,U,12)

                   SET DATA=$PIECE(DATA,U,3,11)

 +11               SET X0=$GET(^ORRT(102.3,DA,0))

                   SET ^(0)=DATA

                   SET ^(1)=SUBJ

                   KILL ^(2)

                   IF $LENGTH(ITMS)

                       Begin DoDot:2

 +12                       FOR I=1:1:$LENGTH(ITMS,"~")

                               SET X=$PIECE(ITMS,"~",I)

                               IF $LENGTH(X)

                                   SET ^ORRT(102.3,DA,2,I,0)=X

                                   SET ^ORRT(102.3,DA,2,"B",X,I)=""

 +13                       SET ^ORRT(102.3,DA,2,0)="^102.31AV^"_I_U_I

                       End DoDot:2

 +14               IF $PIECE(X0,U)'=$PIECE(DATA,U)

                       KILL ^ORRT(102.3,"B",$PIECE(X0,U),DA)

                       SET ^ORRT(102.3,"B",$PIECE(DATA,U),DA)=""

 +15               IF $PIECE(X0,U,3)'=$PIECE(DATA,U,3)

                       KILL ^ORRT(102.3,"C",$PIECE(X0,U,3),DA)

                       SET ^ORRT(102.3,"C",$PIECE(DATA,U,3),DA)=""

 +16               KILL ^ORRT(102.3,"DUE",$PIECE(X0,U,3),DA)

 +17               IF '$PIECE(DATA,U,6)

                       IF '$PIECE(DATA,U,8)

                           SET ^ORRT(102.3,"DUE",$PIECE(DATA,U,3),DA)=""

 +18               SET ORY(ORI)=ID_"^1"

                   LOCK -^ORRT(102.3,DA)

               End DoDot:1

 +19       QUIT 

 +20      ;

COMP(ORY,ORUSR,TASK) ; -- Complete tasks by ORUSR

 +1       ;   where TASK(#) = ID

 +2       ; returns ORY(#)  = ID^1 or ID^0^error, if successful or not

 +3       ; RPC = ORRC TASK COMPLETE

 +4        NEW X,Y,ID,DA,DR,DIE,ORI

 +5        IF $GET(ORUSR)<1

               SET ORY(0)="0^Invalid user identifier"

               QUIT 

 +6        SET DIE="^ORRT(102.3,"

           SET DR="6///NOW;7///"_+ORUSR

 +7        SET ORI=""

           FOR 

               SET ORI=$ORDER(TASK(ORI))

               IF ORI=""

                   QUIT 

               SET ID=TASK(ORI)

               Begin DoDot:1

 +8                SET DA=+$PIECE(ID,":",2)

                   IF DA<1

                       SET ORY(ORI)=ID_"^0^Invalid task number"

                       QUIT 

 +9                LOCK +^ORRT(102.3,DA):5

                   IF '$TEST

                       SET ORY(ORI)=ID_"^0^Another user is editing this task"

                       QUIT 

 +10               DO ^DIE

                   SET ORY(ORI)=ID_"^1"

                   LOCK -^ORRT(102.3,DA)