ANRVOB ; HOIFO/CED - Supports VIST GUI OUTCOMES ; [01-07-2003 12:20]
;;4.0;VISUAL IMPAIRMENT SERVICE TEAM;**5**;JUN 03, 2002
ADDTXT(RESULTS,SUBREC,TOPREC,STATUS,OTCTXT) ; [Procedure] Uploads section text
; Input parameters
; 1. RESULTS [Literal/Required] No description
; 2. SUBREC [Literal/Required] No description
; 3. TOPREC [Literal/Required] No description
; 4. STATUS [Literal/Required] No description
; 5. OTCTXT [Literal/Required] No description
;
N UPSTAT
K ^TMP("OTC",$J)
M ^TMP("OTC",$J,"OTCTXT")=OTCTXT
D WP^DIE(2048.01,SUBREC_","_TOPREC_",",1,"K",$NA(^TMP("OTC",$J,"OTCTXT")))
S ^ANRV(2048,TOPREC,1,SUBREC,0)=SUBREC_U_STATUS ; update status
I $DATA(DIERR) S RESULTS(0)="-1^"_DIERR
E S RESULTS(0)="1^Section Updated"
K ^TMP("OTC",$J)
Q
;
GETREC(RESULTS,PTDFN) ; [Procedure] Get top record and sub records
; Input parameters
; 1. RESULTS [Literal/Required] No description
; 2. PTDFN [Literal/Required] No description
;
N X,Y,IEN,IDATE,DATE,TIME,STATUS,TYPE,S1,S1STAT,S2,S2STAT,S3,S3STAT,S4,S4STAT,S5,S5STAT,S6,S6STAT
K ^TMP($J)
I '$D(^ANRV(2048,"B",PTDFN)) S RESULTS(0)="^0^No Outcome's On Record" Q
F IEN=0:0 S IEN=$O(^ANRV(2048,"B",PTDFN,IEN)) Q:'IEN D
.S IDATE=$P($G(^ANRV(2048,IEN,0)),U,2,2) ;internal date
.S STATUS=$P($G(^ANRV(2048,IEN,0)),U,3,3) ;status(incomplete,complete,partial)
.S TYPE=$P($G(^ANRV(2048,IEN,0)),U,4,4) ;type(Pre or Post)
.S TIME=$E(IDATE,9,10)_":"_$E(IDATE,11,12) ;time top record created
.S:TIME=":" TIME="00:00" ;put it in readable format for user
.S Y=IDATE X ^DD("DD") S DATE=Y ;convertinator
.S S1=$P($G(^ANRV(2048,IEN,1,1,0)),U,1) ;section 1
.S S1STAT=$P($G(^ANRV(2048,IEN,1,1,0)),U,2) ;section 1 status
.S S2=$P($G(^ANRV(2048,IEN,1,2,0)),U,1) ;section 2
.S S2STAT=$P($G(^ANRV(2048,IEN,1,2,0)),U,2) ;section 2 status
.S S3=$P($G(^ANRV(2048,IEN,1,3,0)),U,1) ;section 3
.S S3STAT=$P($G(^ANRV(2048,IEN,1,3,0)),U,2) ;section 3 status
.S S4=$P($G(^ANRV(2048,IEN,1,4,0)),U,1) ;section 4
.S S4STAT=$P($G(^ANRV(2048,IEN,1,4,0)),U,2) ;section 4 status
.S S5=$P($G(^ANRV(2048,IEN,1,5,0)),U,1) ;section 5
.S S5STAT=$P($G(^ANRV(2048,IEN,1,5,0)),U,2) ;section 5 status
.S S6=$P($G(^ANRV(2048,IEN,1,6,0)),U,1) ;section 6
.S S6STAT=$P($G(^ANRV(2048,IEN,1,6,0)),U,2) ;section 6 status
.S RESULTS(IEN)=1_U_IEN_U_IDATE_U_DATE_U_STATUS_U_TYPE_U_S1_U_S1STAT_U_S2_U_S2STAT_U_S3_U_S3STAT_U_S4_U_S4STAT_U_S5_U_S5STAT_U_S6_U_S6STAT
I $DATA(DIERR) S @RESULTS@(0)="-1^"_DIERR
Q
;
GETSEC(RESULTS,RECORD) ; [Procedure] Get Outcome Section
; Input parameters
; 1. RESULTS [Literal/Required] No description
; 2. RECORD [Literal/Required] No description
;
D GETS^DIQ(2048,+RECORD,".01;.02","","RESULTS","DIERR")
I $DATA(DIERR) S @RESULTS@(0)="-1^["_DIERR_"]"
Q
;
GETTXT(RESULTS,SUBREC,TOPREC) ; [Procedure] Gets the Outcome Text
; Input parameters
; 1. RESULTS [Literal/Required] No description
; 2. SUBREC [Literal/Required] No description
; 3. TOPREC [Literal/Required] No description
;
S RESULTS=$$GET1^DIQ(2048.01,SUBREC_","_TOPREC_",",1,"","RESULTS")
Q
;
MKREC(RESULTS,PTDFN,STATUS,TYPE) ; [Procedure] Creates Outcome record
; Input parameters
; 1. RESULTS [Literal/Required] No description
; 2. PTDFN [Literal/Required] No description
; 3. STATUS [Literal/Required] No description
; 4. TYPE [Literal/Required] No description
;
K ^TMP($J)
N X,Y,I,NEWREC,NOW,NEWIEN,ERR
D NOW^%DTC S NOW=%
S NEWREC(2048,"+1,",.01)=PTDFN ; patient ien
S NEWREC(2048,"+1,",.02)=NOW ; date and time
S NEWREC(2048,"+1,",.03)=STATUS ; I=inpatient, O=outpatient, Z=other
S NEWREC(2048,"+1,",.04)=TYPE ; R=Pre or O=Post Outcome
D UPDATE^DIE("","NEWREC","NEWIEN")
S ^ANRV(2048,NEWIEN(1),1,0)="^2048.01,.01P^^"
F X=0:0 S X=$O(^ANRV(2048.1,X)) Q:'X D
.S ^ANRV(2048,NEWIEN(1),1,X,0)=X
.S ^ANRV(2048,NEWIEN(1),1,"B",X,X)=""
S RESULTS(0)="1"_U_NEWIEN(1)
I $DATA(DIERR) S RESULTS(0)="-1^"_U_DIERR
Q
;
RPC(RESULTS,OPTION,DATA) ; [Procedure] Main RPC Entry.
; Input parameters
; 1. RESULTS [Literal/Required] No description
; 2. OPTION [Literal/Required] No description
; 3. DATA [Literal/Required] No description
;
S RESULTS=$NA(^TMP("ANRVUSER",$J)) K @RESULTS
D:$T(@OPTION)]"" @OPTION
S:'$D(@RESULTS) @RESULTS@(0)="-1^No results returned"
D CLEAN^DILF
Q
;
SNDTXT(RESULTS,ANRVCMD,DATA) ; [Procedure] Send completed Outcome
; Input parameters
; 1. RESULTS [Literal/Required] No description
; 2. ANRVCMD [Literal/Required] No description
; 3. DATA [Literal/Required] No description
;
S RESULTS=$NA(^TMP($J)),^TMP($J,0)="-1^Unknown Error"
D:ANRVCMD="CREATE"
.K ^TMP("ANRVMAIL",$J)
.S ^TMP($J,0)="1^Message '"_$J_"' created."
D:ANRVCMD="APPEND"
.D:$G(DATA)]""
..S Y=$O(^TMP("ANRVMAIL",$J,"TEXT",""),-1)+1
..S ^TMP("ANRVMAIL",$J,"TEXT",Y,0)=DATA
.S X="DATA"
.F S X=$Q(@X) Q:X="" D
..S Y=$O(^TMP("ANRVMAIL",$J,"TEXT",""),-1)+1
..S ^TMP("ANRVMAIL",$J,"TEXT",Y,0)=@X
.S Y=+$O(^TMP("ANRVMAIL",$J,"TEXT",""),-1)
.S ^TMP("ANRVMAIL",$J,"TEXT",0)="^^"_Y
.S ^TMP($J,0)="1^Text appended."
D:ANRVCMD="SUBJECT"
.S ^TMP("ANRVMAIL",$J,"SUBJECT")=DATA
.S ^TMP($J,0)="1^Message subject set to '"_DATA_"'"
D:ANRVCMD="SENDTO"
.D:$G(DATA)]""
..S Y=$O(^TMP("ANRVMAIL",$J,"SENDTO",""),-1)+1
..S ^TMP("ANRVMAIL",$J,"SENDTO",Y)=DATA
.S X="DATA"
.F S X=$Q(@X) Q:X="" D
..S Y=$O(^TMP("ANRVMAIL",$J,"SENDTO",""),-1)+1
..S ^TMP("ANRVMAIL",$J,"SENDTO",Y)=@X
.S ^TMP($J,0)="1^Recipients Added."
D:ANRVCMD="EXECUTE"
.S XMSUB=$G(^TMP("ANRVMAIL",$J,"SUBJECT"),"No subject")
.S XMTEXT="^TMP(""ANRVMAIL"",$J,""TEXT"","
.F X=0:0 S X=$O(^TMP("ANRVMAIL",$J,"SENDTO",X)) Q:'X D
..S XMY(^(X))=""
.D ^XMD
.S ^TMP($J,0)="1^Message Sent. ID: "_+$G(XMZ)
Q
;
UPREC(RESULTS,TOPREC,STATUS) ; [Procedure] Update Top Record Status
; Input parameters
; 1. RESULTS [Literal/Required] No description
; 2. TOPREC [Literal/Required] No description
; 3. STATUS [Literal/Required] No description
;
N MYFDA
S MYFDA(2048,TOPREC_",",.03)=STATUS
D FILE^DIE("","MYFDA")
I $DATA(DIERR) S RESULTS="-1^"_DIERR
E S RESULTS="1^SECTION UPDATED"
Q
;
ADD(X) ; [Function] Adds data to @Results@
; Input parameters
; 1. X [Literal/Required] No description
;
S @RESULTS@(+$O(@RESULTS@(""),-1)+1)=X
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HANRVOB 6371 printed Dec 13, 2024@02:45:48 Page 2
ANRVOB ; HOIFO/CED - Supports VIST GUI OUTCOMES ; [01-07-2003 12:20]
+1 ;;4.0;VISUAL IMPAIRMENT SERVICE TEAM;**5**;JUN 03, 2002
ADDTXT(RESULTS,SUBREC,TOPREC,STATUS,OTCTXT) ; [Procedure] Uploads section text
+1 ; Input parameters
+2 ; 1. RESULTS [Literal/Required] No description
+3 ; 2. SUBREC [Literal/Required] No description
+4 ; 3. TOPREC [Literal/Required] No description
+5 ; 4. STATUS [Literal/Required] No description
+6 ; 5. OTCTXT [Literal/Required] No description
+7 ;
+8 NEW UPSTAT
+9 KILL ^TMP("OTC",$JOB)
+10 MERGE ^TMP("OTC",$JOB,"OTCTXT")=OTCTXT
+11 DO WP^DIE(2048.01,SUBREC_","_TOPREC_",",1,"K",$NAME(^TMP("OTC",$JOB,"OTCTXT")))
+12 ; update status
SET ^ANRV(2048,TOPREC,1,SUBREC,0)=SUBREC_U_STATUS
+13 IF $DATA(DIERR)
SET RESULTS(0)="-1^"_DIERR
+14 IF '$TEST
SET RESULTS(0)="1^Section Updated"
+15 KILL ^TMP("OTC",$JOB)
+16 QUIT
+17 ;
GETREC(RESULTS,PTDFN) ; [Procedure] Get top record and sub records
+1 ; Input parameters
+2 ; 1. RESULTS [Literal/Required] No description
+3 ; 2. PTDFN [Literal/Required] No description
+4 ;
+5 NEW X,Y,IEN,IDATE,DATE,TIME,STATUS,TYPE,S1,S1STAT,S2,S2STAT,S3,S3STAT,S4,S4STAT,S5,S5STAT,S6,S6STAT
+6 KILL ^TMP($JOB)
+7 IF '$DATA(^ANRV(2048,"B",PTDFN))
SET RESULTS(0)="^0^No Outcome's On Record"
QUIT
+8 FOR IEN=0:0
SET IEN=$ORDER(^ANRV(2048,"B",PTDFN,IEN))
if 'IEN
QUIT
Begin DoDot:1
+9 ;internal date
SET IDATE=$PIECE($GET(^ANRV(2048,IEN,0)),U,2,2)
+10 ;status(incomplete,complete,partial)
SET STATUS=$PIECE($GET(^ANRV(2048,IEN,0)),U,3,3)
+11 ;type(Pre or Post)
SET TYPE=$PIECE($GET(^ANRV(2048,IEN,0)),U,4,4)
+12 ;time top record created
SET TIME=$EXTRACT(IDATE,9,10)_":"_$EXTRACT(IDATE,11,12)
+13 ;put it in readable format for user
if TIME="
SET TIME="00:00"
+14 ;convertinator
SET Y=IDATE
XECUTE ^DD("DD")
SET DATE=Y
+15 ;section 1
SET S1=$PIECE($GET(^ANRV(2048,IEN,1,1,0)),U,1)
+16 ;section 1 status
SET S1STAT=$PIECE($GET(^ANRV(2048,IEN,1,1,0)),U,2)
+17 ;section 2
SET S2=$PIECE($GET(^ANRV(2048,IEN,1,2,0)),U,1)
+18 ;section 2 status
SET S2STAT=$PIECE($GET(^ANRV(2048,IEN,1,2,0)),U,2)
+19 ;section 3
SET S3=$PIECE($GET(^ANRV(2048,IEN,1,3,0)),U,1)
+20 ;section 3 status
SET S3STAT=$PIECE($GET(^ANRV(2048,IEN,1,3,0)),U,2)
+21 ;section 4
SET S4=$PIECE($GET(^ANRV(2048,IEN,1,4,0)),U,1)
+22 ;section 4 status
SET S4STAT=$PIECE($GET(^ANRV(2048,IEN,1,4,0)),U,2)
+23 ;section 5
SET S5=$PIECE($GET(^ANRV(2048,IEN,1,5,0)),U,1)
+24 ;section 5 status
SET S5STAT=$PIECE($GET(^ANRV(2048,IEN,1,5,0)),U,2)
+25 ;section 6
SET S6=$PIECE($GET(^ANRV(2048,IEN,1,6,0)),U,1)
+26 ;section 6 status
SET S6STAT=$PIECE($GET(^ANRV(2048,IEN,1,6,0)),U,2)
+27 SET RESULTS(IEN)=1_U_IEN_U_IDATE_U_DATE_U_STATUS_U_TYPE_U_S1_U_S1STAT_U_S2_U_S2STAT_U_S3_U_S3STAT_U_S4_U_S4STAT_U_S5_U_S5STAT_U_S6_U_S6STAT
End DoDot:1
+28 IF $DATA(DIERR)
SET @RESULTS@(0)="-1^"_DIERR
+29 QUIT
+30 ;
GETSEC(RESULTS,RECORD) ; [Procedure] Get Outcome Section
+1 ; Input parameters
+2 ; 1. RESULTS [Literal/Required] No description
+3 ; 2. RECORD [Literal/Required] No description
+4 ;
+5 DO GETS^DIQ(2048,+RECORD,".01;.02","","RESULTS","DIERR")
+6 IF $DATA(DIERR)
SET @RESULTS@(0)="-1^["_DIERR_"]"
+7 QUIT
+8 ;
GETTXT(RESULTS,SUBREC,TOPREC) ; [Procedure] Gets the Outcome Text
+1 ; Input parameters
+2 ; 1. RESULTS [Literal/Required] No description
+3 ; 2. SUBREC [Literal/Required] No description
+4 ; 3. TOPREC [Literal/Required] No description
+5 ;
+6 SET RESULTS=$$GET1^DIQ(2048.01,SUBREC_","_TOPREC_",",1,"","RESULTS")
+7 QUIT
+8 ;
MKREC(RESULTS,PTDFN,STATUS,TYPE) ; [Procedure] Creates Outcome record
+1 ; Input parameters
+2 ; 1. RESULTS [Literal/Required] No description
+3 ; 2. PTDFN [Literal/Required] No description
+4 ; 3. STATUS [Literal/Required] No description
+5 ; 4. TYPE [Literal/Required] No description
+6 ;
+7 KILL ^TMP($JOB)
+8 NEW X,Y,I,NEWREC,NOW,NEWIEN,ERR
+9 DO NOW^%DTC
SET NOW=%
+10 ; patient ien
SET NEWREC(2048,"+1,",.01)=PTDFN
+11 ; date and time
SET NEWREC(2048,"+1,",.02)=NOW
+12 ; I=inpatient, O=outpatient, Z=other
SET NEWREC(2048,"+1,",.03)=STATUS
+13 ; R=Pre or O=Post Outcome
SET NEWREC(2048,"+1,",.04)=TYPE
+14 DO UPDATE^DIE("","NEWREC","NEWIEN")
+15 SET ^ANRV(2048,NEWIEN(1),1,0)="^2048.01,.01P^^"
+16 FOR X=0:0
SET X=$ORDER(^ANRV(2048.1,X))
if 'X
QUIT
Begin DoDot:1
+17 SET ^ANRV(2048,NEWIEN(1),1,X,0)=X
+18 SET ^ANRV(2048,NEWIEN(1),1,"B",X,X)=""
End DoDot:1
+19 SET RESULTS(0)="1"_U_NEWIEN(1)
+20 IF $DATA(DIERR)
SET RESULTS(0)="-1^"_U_DIERR
+21 QUIT
+22 ;
RPC(RESULTS,OPTION,DATA) ; [Procedure] Main RPC Entry.
+1 ; Input parameters
+2 ; 1. RESULTS [Literal/Required] No description
+3 ; 2. OPTION [Literal/Required] No description
+4 ; 3. DATA [Literal/Required] No description
+5 ;
+6 SET RESULTS=$NAME(^TMP("ANRVUSER",$JOB))
KILL @RESULTS
+7 if $TEXT(@OPTION)]""
DO @OPTION
+8 if '$DATA(@RESULTS)
SET @RESULTS@(0)="-1^No results returned"
+9 DO CLEAN^DILF
+10 QUIT
+11 ;
SNDTXT(RESULTS,ANRVCMD,DATA) ; [Procedure] Send completed Outcome
+1 ; Input parameters
+2 ; 1. RESULTS [Literal/Required] No description
+3 ; 2. ANRVCMD [Literal/Required] No description
+4 ; 3. DATA [Literal/Required] No description
+5 ;
+6 SET RESULTS=$NAME(^TMP($JOB))
SET ^TMP($JOB,0)="-1^Unknown Error"
+7 if ANRVCMD="CREATE"
Begin DoDot:1
+8 KILL ^TMP("ANRVMAIL",$JOB)
+9 SET ^TMP($JOB,0)="1^Message '"_$JOB_"' created."
End DoDot:1
+10 if ANRVCMD="APPEND"
Begin DoDot:1
+11 if $GET(DATA)]""
Begin DoDot:2
+12 SET Y=$ORDER(^TMP("ANRVMAIL",$JOB,"TEXT",""),-1)+1
+13 SET ^TMP("ANRVMAIL",$JOB,"TEXT",Y,0)=DATA
End DoDot:2
+14 SET X="DATA"
+15 FOR
SET X=$QUERY(@X)
if X=""
QUIT
Begin DoDot:2
+16 SET Y=$ORDER(^TMP("ANRVMAIL",$JOB,"TEXT",""),-1)+1
+17 SET ^TMP("ANRVMAIL",$JOB,"TEXT",Y,0)=@X
End DoDot:2
+18 SET Y=+$ORDER(^TMP("ANRVMAIL",$JOB,"TEXT",""),-1)
+19 SET ^TMP("ANRVMAIL",$JOB,"TEXT",0)="^^"_Y
+20 SET ^TMP($JOB,0)="1^Text appended."
End DoDot:1
+21 if ANRVCMD="SUBJECT"
Begin DoDot:1
+22 SET ^TMP("ANRVMAIL",$JOB,"SUBJECT")=DATA
+23 SET ^TMP($JOB,0)="1^Message subject set to '"_DATA_"'"
End DoDot:1
+24 if ANRVCMD="SENDTO"
Begin DoDot:1
+25 if $GET(DATA)]""
Begin DoDot:2
+26 SET Y=$ORDER(^TMP("ANRVMAIL",$JOB,"SENDTO",""),-1)+1
+27 SET ^TMP("ANRVMAIL",$JOB,"SENDTO",Y)=DATA
End DoDot:2
+28 SET X="DATA"
+29 FOR
SET X=$QUERY(@X)
if X=""
QUIT
Begin DoDot:2
+30 SET Y=$ORDER(^TMP("ANRVMAIL",$JOB,"SENDTO",""),-1)+1
+31 SET ^TMP("ANRVMAIL",$JOB,"SENDTO",Y)=@X
End DoDot:2
+32 SET ^TMP($JOB,0)="1^Recipients Added."
End DoDot:1
+33 if ANRVCMD="EXECUTE"
Begin DoDot:1
+34 SET XMSUB=$GET(^TMP("ANRVMAIL",$JOB,"SUBJECT"),"No subject")
+35 SET XMTEXT="^TMP(""ANRVMAIL"",$J,""TEXT"","
+36 FOR X=0:0
SET X=$ORDER(^TMP("ANRVMAIL",$JOB,"SENDTO",X))
if 'X
QUIT
Begin DoDot:2
+37 SET XMY(^(X))=""
End DoDot:2
+38 DO ^XMD
+39 SET ^TMP($JOB,0)="1^Message Sent. ID: "_+$GET(XMZ)
End DoDot:1
+40 QUIT
+41 ;
UPREC(RESULTS,TOPREC,STATUS) ; [Procedure] Update Top Record Status
+1 ; Input parameters
+2 ; 1. RESULTS [Literal/Required] No description
+3 ; 2. TOPREC [Literal/Required] No description
+4 ; 3. STATUS [Literal/Required] No description
+5 ;
+6 NEW MYFDA
+7 SET MYFDA(2048,TOPREC_",",.03)=STATUS
+8 DO FILE^DIE("","MYFDA")
+9 IF $DATA(DIERR)
SET RESULTS="-1^"_DIERR
+10 IF '$TEST
SET RESULTS="1^SECTION UPDATED"
+11 QUIT
+12 ;
ADD(X) ; [Function] Adds data to @Results@
+1 ; Input parameters
+2 ; 1. X [Literal/Required] No description
+3 ;
+4 SET @RESULTS@(+$ORDER(@RESULTS@(""),-1)+1)=X
+5 QUIT
+6 ;
