- 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 Feb 19, 2025@00:12:19 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 ;
