Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VPSSRVY2

VPSSRVY2.m

Go to the documentation of this file. 
  1. VPSSRVY2 ;WOIFO/BT - VPS CLINICAL SURVEY QUESTIONNAIRE;01/16/2015 11:23
  1.  ;;1.0;VA POINT OF SERVICE (KIOSKS);**5,14**;Jan 16, 2015;Build 26
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; External Reference DBIA#
  1.  ; ------------------------
  1.  ;
  1.  QUIT
  1. GETRPC(VPSRES,VPSPID,VPSTYP,VPSQIEN,VPSQNM,VPSFDT,VPSTDT,VPSNUM,AHFLG) ;
  1.  ;INPUT
  1.  ;  VPSPID  : Parameter Value - patient SSN OR DFN OR ICN OR VIC/CAC (REQUIRED)
  1.  ;  VPSTYP  - Parameter TYPE - SSN or DFN OR ICN OR VIC/CAC (REQUIRED)
  1.  ;  VPSQIEN : Questionnaire IEN
  1.  ;  VPSQNM  : Questionnaire Name
  1.  ;  VPSFDT  : From Date
  1.  ;  VPSTDT  : To Date
  1.  ;  VPSNUM  : Number of Occurrences
  1.  ;  AHFLG   : Answer history Flag
  1.  ;            current answer          - 0 (default)
  1.  ;            all answers to question - 1     1
  1.  ;
  1.  ;OUTPUT
  1.  ; If error
  1.  ;  VPSRES(0)=-1^Error Message
  1.  ;
  1.  ; otherwise
  1.  ;  VPSRES(0)=1^Number of Questionnaires
  1.  ;  VPSRES(1) = <CSQ>
  1.  ;  VPSRES(2) =     PATIENT ^ QUESTIONNAIRE TEMPLATE ID ^ QUESTIONNAIRE TEMPLATE NAME ^ QUESTIONNAIRE TEMPLATE IEN ^ VERSION
  1.  ;  VPSRES(3) =     <RESPONSE>
  1.  ;  VPSRES(4) =          RESPONSE IDENTIFIER ^ DATE/TIME TAKEN ^ DATE/TIME LAST MODIFIED ^ COMPLETION STATUS ^ PATIENT SAFETY ^ IMMEDIATE ACTION ^ SURVEY CALCULATED VALUE
  1.  ;  VPSRES(5) =          <APPOINTMENT CHECK-IN>
  1.  ;  VPSRES(6) =               APPOINTMENT CHECK-IN ID
  1.  ;  VPSRES(7) =          </APPOINTMENT CHECK-IN>
  1.  ;  VPSRES(8) =          <ADDITIONAL CALCULATED VALUE>
  1.  ;  VPSRES(9) =               ADDITIONAL CALC VALUE NAME ^ ADDITIONAL CALC VALUE SCORE
  1.  ;  VPSRES(10) =          </ADDITIONAL CALCULATED VALUE>
  1.  ;  VPSRES(11) =          <QUESTIONS>
  1.  ;  VPSRES(12) =               QUESTION NUMBER ^ QUESTION CALCULATED VALUE
  1.  ;  VPSRES(13) =               <QUESTION PRESENTED>
  1.  ;  VPSRES(14) =                    QUESTION TEXT....
  1.  ;  VPSRES(15) =               </QUESTION PRESENTED>
  1.  ;  VPSRES(16) =               <ANSWER>
  1.  ;  VPSRES(17) =                    ANSWER IDENTIFIER ^ INTERFACE USED ^ RESPONDENT ^ RESPONDENT NAME ^ ANSWER DATE/TIME ^ INTERVIEWER NAME ^ KIOSK IDENTIFIER ^ KIOSK SESSION IDENTIFIER ^ KIOSK GROUP IDENTIFIER
  1.  ;  VPSRES(18) =                    <ANSWER RESPONSE>
  1.  ;  VPSRES(19) =                         ANSWER TEXT
  1.  ;  VPSRES(20) =                    </ANSWER RESPONSE>
  1.  ;  VPSRES(21) =               </ANSWER>
  1.  ;  VPSRES(22) =          </QUESTIONS>
  1.  ;  VPSRES(23) =     </RESPONSE>
  1.  ;  VPSRES(24) = </CSQ>
  1.  ;  VPSRES(25) = <CSQ> 
  1.  ;  ...
  1.  ;  VPSRES(n) = </CSQ>
  1.  ;
  1.  ;
  1.  K ^TMP("VPSGSRY",$J)
  1.  S VPSRES=$NA(^TMP("VPSGSRY",$J))
  1.  N VPSDFN
  1.  I $G(VPSTYP)="" S VPSTYP="DFN"
  1.  I $G(VPSQNM)]"" S VPSQNM=$$UPCASE(VPSQNM)
  1.  S VPSDFN=$$VALIDATE^VPSRPC1($G(VPSTYP),$G(VPSPID))
  1.  I +VPSDFN=-1 D ADDERR(VPSDFN) Q
  1.  I $G(VPSDFN)="" D ADDERR("-1^Patient IEN not sent") Q
  1.  I '$D(^DPT(VPSDFN)) D ADDERR("-1^Patient not found") Q
  1.  I '$D(^VPS(853.8,VPSDFN)) D ADDERR("-1^No questionnaires found") Q
  1.  ;
  1.  N FDT,CNT,FLG,DAT,DATA,X,Y,TID,TMP
  1.  S FDT=0,TID=0
  1.  S CNT=0,FLG=0
  1.  I $G(VPSFDT)["T" S X=VPSFDT D ^%DT S VPSFDT=Y I Y=-1 D ADDERR("-1^Issue with From Date") Q
  1.  I $G(VPSTDT)["T" S X=VPSTDT D ^%DT S VPSTDT=Y I Y=-1 D ADDERR("-1^Issue with To Date") Q
  1.  I $G(VPSFDT) S FDT=$P(VPSFDT,".")-.000001
  1.  I $G(VPSTDT) S VPSTDT=$P(VPSTDT,".")_".999999"
  1.  N VFDT
  1.  S VFDT=FDT
  1.  F  S TID=$O(^VPS(853.8,VPSDFN,1,TID)) Q:'TID  D
  1.  . S FDT=VFDT
  1.  . F  S FDT=$O(^VPS(853.8,VPSDFN,1,TID,1,FDT)) Q:'FDT  D
  1.  .. I $G(VPSTDT),FDT>VPSTDT Q
  1.  .. I $$PASSCHK(TID,$G(VPSQIEN),$G(VPSQNM)) S TMP(FDT,TID)=""
  1.  S FDT=""
  1.  N LN
  1.  S LN=0
  1.  F  S FDT=$O(TMP(FDT)) Q:'FDT!(FLG)  D
  1.  . S TID=""
  1.  . F  S TID=$O(TMP(FDT,TID)) Q:'TID!(FLG)  D
  1.  .. S LN=LN+1
  1.  .. D STORE(LN,"<CSQ>")
  1.  .. D GETDATA(.LN,TID,FDT)
  1.  .. S CNT=CNT+1
  1.  .. I $G(VPSNUM),CNT=VPSNUM S FLG=1 Q
  1.  . S LN=LN+1
  1.  . D STORE(LN,"</CSQ>")
  1.  D STORE(0,"1^"_CNT)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. PASSCHK(ID1,VPSQIEN,VPSQNM) ;
  1.  ; test is see if this is the survey being requested
  1.  I $G(VPSQIEN)="",$G(VPSQNM)="" Q 1
  1.  N ID,FLG
  1.  S FLG=1
  1.  I $G(VPSQIEN)]"" D  Q 'FLG
  1.  . S ID=$O(^VPS(853.85,"B",VPSQIEN,""))
  1.  . I ID1=ID S FLG=0
  1.  I $G(VPSQNM)]"" D  Q 'FLG
  1.  . I $$GET1^DIQ(853.85,ID1_",",1)=VPSQNM S FLG=0
  1.  Q 0
  1.  ;
  1.  ;
  1. ADDERR(MSG) ;add error message to result array
  1.  S ^TMP("VPSGSRY",$J,0)=MSG
  1.  Q
  1.  ;
  1. GETDATA(LN,TID,FDT) ;
  1.  N I,DAT,DATA
  1.  S DATA=$G(^VPS(853.8,VPSDFN,1,TID,1,FDT,1,1,0))
  1.  ; Patient DFN ^ Patient Name ^  Template ID ^ Questionnaire Name ^ Version
  1.  S DAT=VPSDFN_U_$$GET1^DIQ(2,VPSDFN_",",.01)_U_$E($$GET1^DIQ(853.85,TID_",",.01),5,99)_U_$$GET1^DIQ(853.85,TID_",",1)_U_$$GET1^DIQ(853.85,TID_",",2)
  1.  S LN=LN+1
  1.  D STORE(LN,DAT)
  1.  S LN=LN+1
  1.  D STORE(LN,"<RESPONSE>")
  1.  ; Obtain Response identifier
  1.  S DAT=$$GET1^DIQ(853.811,"1,"_FDT_","_TID_","_VPSDFN_",",.01)
  1.  ; Obtain converted Date and Time Taken
  1.  S DAT=DAT_U_$$GET1^DIQ(853.811,"1,"_FDT_","_TID_","_VPSDFN_",",.02)
  1.  ; Obtain Date and Time Last Modified and convert to external format
  1.  S DAT=DAT_U_$$GET1^DIQ(853.811,"1,"_FDT_","_TID_","_VPSDFN_",",.03)
  1.  ; Obtain COMPLETION STATUS
  1.  S DAT=DAT_U_$$GET1^DIQ(853.811,"1,"_FDT_","_TID_","_VPSDFN_",",.04)
  1.  ; Obtain PATIENT SAFETY
  1.  S DAT=DAT_U_$$GET1^DIQ(853.811,"1,"_FDT_","_TID_","_VPSDFN_",",.05)
  1.  ; Obtain IMMEDIATE ACTION
  1.  S DAT=DAT_U_$$GET1^DIQ(853.811,"1,"_FDT_","_TID_","_VPSDFN_",",.06)
  1.  ; Obtain SURVEY CALCULATED VALUE
  1.  S DAT=DAT_U_$$GET1^DIQ(853.811,"1,"_FDT_","_TID_","_VPSDFN_",",4)
  1.  S LN=LN+1
  1.  D STORE(LN,DAT)
  1.  S LN=LN+1
  1.  D STORE(LN,"<APPOINTMENT CHECK-IN>")
  1.  S I=0
  1.  F  S I=$O(^VPS(853.8,VPSDFN,1,TID,1,FDT,1,1,1,I)) Q:'I  D
  1.  . S DAT=^VPS(853.8,VPSDFN,1,TID,1,FDT,1,1,1,I,0)
  1.  . S LN=LN+1
  1.  . D STORE(LN,DAT)
  1.  S LN=LN+1
  1.  D STORE(LN,"</APPOINTMENT CHECK-IN>")
  1.  S LN=LN+1
  1.  D STORE(LN,"<ADDITIONAL CALCULATED VALUE>")
  1.  S I=0
  1.  F  S I=$O(^VPS(853.8,VPSDFN,1,TID,1,FDT,1,1,2,I)) Q:'I  D
  1.  . S DAT=^VPS(853.8,VPSDFN,1,TID,1,FDT,1,1,2,I,0)
  1.  . S LN=LN+1
  1.  . D STORE(LN,DAT)
  1.  S LN=LN+1
  1.  D STORE(LN,"</APPOINTMENT CHECK-IN>")
  1.  S LN=LN+1
  1.  D STORE(LN,"<QUESTIONS>")
  1.  N J,II
  1.  S I=0
  1.  F  S I=$O(^VPS(853.8,VPSDFN,1,TID,1,FDT,1,1,3,I)) Q:'I  D
  1.  . S DAT=$$GET1^DIQ(853.8113,I_",1,"_FDT_","_TID_","_VPSDFN_",",.01)
  1.  . S DAT=DAT_U_$$GET1^DIQ(853.8113,I_",1,"_FDT_","_TID_","_VPSDFN_",",1)
  1.  . S LN=LN+1
  1.  . D STORE(LN,DAT)
  1.  . S LN=LN+1
  1.  . D STORE(LN,"<QUESTION PRESENTED>")
  1.  . N TMP
  1.  . I $$GET1^DIQ(853.8113,I_",1,"_FDT_","_TID_","_VPSDFN_",",2,"","TMP")
  1.  . S J=0
  1.  . F  S J=$O(TMP(J)) Q:'J  S LN=LN+1 D STORE(LN,TMP(J))
  1.  . S LN=LN+1
  1.  . D STORE(LN,"</QUESTION PRESENTED>")
  1.  . ;S LN=LN+1
  1.  . ;D STORE(LN,"<ANSWER>")
  1.  . S II="A"
  1.  . N CUR
  1.  . S CUR=0
  1.  . F  S II=$O(^VPS(853.8,VPSDFN,1,TID,1,FDT,1,1,3,I,3,II),-1) Q:'II!(CUR=99&(+$G(AHFLG)=0))  D
  1.  .. ; Obtain ANSWER IDENTIFIER
  1.  .. I CUR'=0,CUR'=$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",1),+$G(AHFLG)=0 S CUR=99 Q
  1.  .. S LN=LN+1
  1.  .. D STORE(LN,"<ANSWER>")
  1.  .. I CUR=0 S CUR=$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",1)
  1.  .. S DAT=$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",.01)
  1.  .. S DAT=DAT_U_$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",.02)
  1.  .. S DAT=DAT_U_$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",.03)
  1.  .. S DAT=DAT_U_$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",.04)
  1.  .. S DAT=DAT_U_$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",1)
  1.  .. S DAT=DAT_U_$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",2)
  1.  .. S DAT=DAT_U_$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",3)
  1.  .. S DAT=DAT_U_$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",4)
  1.  .. S DAT=DAT_U_$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",5)
  1.  .. S LN=LN+1
  1.  .. D STORE(LN,DAT)
  1.  .. S DAT=""
  1.  .. S LN=LN+1
  1.  .. D STORE(LN,"<ANSWER RESPONSE>")
  1.  .. K TMP
  1.  .. I $$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",6,"","TMP")
  1.  .. S J=0
  1.  .. F  S J=$O(TMP(J)) Q:'J  S LN=LN+1 D STORE(LN,TMP(J))
  1.  .. S LN=LN+1
  1.  .. D STORE(LN,"</ANSWER RESPONSE>")
  1.  .. S LN=LN+1
  1.  .. D STORE(LN,"</ANSWER>")
  1.  . ;S LN=LN+1
  1.  . ;D STORE(LN,"</ANSWER>")
  1.  S LN=LN+1
  1.  D STORE(LN,"</QUESTIONS>")
  1.  S LN=LN+1
  1.  D STORE(LN,"</RESPONSE>")
  1.  Q
  1.  ;
  1. APPEND(LINE,ARR) ;
  1.  N J,STR
  1.  S J=0
  1.  F  S J=$O(ARR(J)) Q:'J  S STR=STR_ARR(J)
  1.  I LINE=""  S LINE=STR
  1.  E  S LINE=LINE_U_STR
  1.  Q
  1.  ;
  1. STORE(IEN,MSG) ;add message to result array
  1.  S ^TMP("VPSGSRY",$J,IEN)=MSG
  1.  Q
  1.  ;
  1.  ; Convert string to upper case
  1. UPCASE(X) ;
  1.  N STR,I
  1.  S STR=""
  1.  F I=1:1:$L(X) S STR=STR_$$CAP($E(X,I))
  1.  Q STR
  1.  ;
  1. CAP(X) ; Convert lower case X to UPPER CASE
  1.  Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")