YTRPEXT ;DALOI/YH-I/O FOR STAFF REMARKS ;8/22/2001
;;5.01;MENTAL HEALTH;**71**;Dec 30, 1994
;
ADDCOMM(RESULT,YSDATA,YSCOMMT) ;YTAPI SAVE TEST COMMENT
N YSDFN,YSET,YSED
S YSDFN=+$P(YSDATA,"^"),YSET=$P(YSDATA,"^",4),YSET=$O(^YTT(601,"B",YSET,0)),YSED=+$P(YSDATA,"^",3)
I '$D(^YTD(601.2,YSDFN,1,YSET,1,YSED)) S RESULT(1)="[ERROR]",RESULT(2)="No test found" Q
N YSAUTHOR,YSDUZ,YSDN,I S I=+$P(YSDATA,"^",6)
I I=0 S RESULT(1)="[ERROR]",RESULT(2)="No comment entered" Q
S YSAUTHOR=+$P(YSDATA,"^",2),YSDUZ=+$P(YSDATA,"^",5)
S:'$D(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",0)) ^(0)="^601.2213D^^" S DIC="^YTD(601.2,YSDFN,1,YSET,1,YSED,""R"",",DIC(0)="L",DLAYGO=601,X="T" D ^DIC G:Y<1 OUT S YSDN=+Y
S DIE=DIC,DA=+Y,DR="1///TODAY;2///`"_DUZ_";3///`"_YSAUTHOR,DA(3)=YSDFN,DA(2)=YSET,DA(1)=YSED L +^YTD(601.2,YSDFN):0 Q:'$T D ^DIE
S ^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",YSDN,1,0)="^^"_I_"^"_I_"^"_$P(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",YSDN,0),"^",2)_"^"
N YS F YS=1:1:I S ^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",YSDN,1,YS,0)=YSCOMMT(YS)
L -^YTD(601.2,YSDFN)
S RESULT(1)="[DATA]",RESULT(2)="Save ok"
Q
OUT S RESULT(1)="[ERROR]",RESULT(2)="Comment line not created" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTRPEXT 1173 printed Dec 13, 2024@02:19:07 Page 2
YTRPEXT ;DALOI/YH-I/O FOR STAFF REMARKS ;8/22/2001
+1 ;;5.01;MENTAL HEALTH;**71**;Dec 30, 1994
+2 ;
ADDCOMM(RESULT,YSDATA,YSCOMMT) ;YTAPI SAVE TEST COMMENT
+1 NEW YSDFN,YSET,YSED
+2 SET YSDFN=+$PIECE(YSDATA,"^")
SET YSET=$PIECE(YSDATA,"^",4)
SET YSET=$ORDER(^YTT(601,"B",YSET,0))
SET YSED=+$PIECE(YSDATA,"^",3)
+3 IF '$DATA(^YTD(601.2,YSDFN,1,YSET,1,YSED))
SET RESULT(1)="[ERROR]"
SET RESULT(2)="No test found"
QUIT
+4 NEW YSAUTHOR,YSDUZ,YSDN,I
SET I=+$PIECE(YSDATA,"^",6)
+5 IF I=0
SET RESULT(1)="[ERROR]"
SET RESULT(2)="No comment entered"
QUIT
+6 SET YSAUTHOR=+$PIECE(YSDATA,"^",2)
SET YSDUZ=+$PIECE(YSDATA,"^",5)
+7 if '$DATA(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",0))
SET ^(0)="^601.2213D^^"
SET DIC="^YTD(601.2,YSDFN,1,YSET,1,YSED,""R"","
SET DIC(0)="L"
SET DLAYGO=601
SET X="T"
DO ^DIC
if Y<1
GOTO OUT
SET YSDN=+Y
+8 SET DIE=DIC
SET DA=+Y
SET DR="1///TODAY;2///`"_DUZ_";3///`"_YSAUTHOR
SET DA(3)=YSDFN
SET DA(2)=YSET
SET DA(1)=YSED
LOCK +^YTD(601.2,YSDFN):0
if '$TEST
QUIT
DO ^DIE
+9 SET ^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",YSDN,1,0)="^^"_I_"^"_I_"^"_$PIECE(^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",YSDN,0),"^",2)_"^"
+10 NEW YS
FOR YS=1:1:I
SET ^YTD(601.2,YSDFN,1,YSET,1,YSED,"R",YSDN,1,YS,0)=YSCOMMT(YS)
+11 LOCK -^YTD(601.2,YSDFN)
+12 SET RESULT(1)="[DATA]"
SET RESULT(2)="Save ok"
+13 QUIT
OUT SET RESULT(1)="[ERROR]"
SET RESULT(2)="Comment line not created"
QUIT
