YTRPEXT.m

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 ---YTRPEXT   1173     printed  Apr 09, 2024@21:18:22                                                                                                                                                                                                     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