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

VPSSRVY3.m

Go to the documentation of this file. 
  1. VPSSRVY3 ;WOIFO/BT - VPS CLINICAL SURVEY QUESTIONNAIRE;01/16/15 13:07
  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. UTGET(VPSDFN,TARGET,VPSQIEN,VPSQNM,VPSFDT,VPSTDT,VPSNUM) ;
  1.  N UTFLG,UT
  1.  S UTFLG=1
  1.  S UT=$$GETRPT(VPSDFN,TARGET)
  1.  ;S UT=$$GETRPT(VPSDFN,TARGET,$G(VPSQIEN),$G(VPSQNM),$G(VPSFDT),$G(VPSTDT),$G(VPSNUM))
  1.  Q UT
  1.  ;
  1. GETRPT(VPSDFN,TARGET,VPSQIEN,VPSQNM,VPSFDT,VPSTDT,VPSNUM,AHFLG) ;
  1.  ;INPUT
  1.  ;  VPSDFN  : Patient IEN
  1.  ;  TARGET  : Location for the results
  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.  ;  RESULT(0) = Success or Fail flag
  1.  ;RESULT(1..n) = Formatted Questionnaire data
  1.  ;
  1.  ;Example:
  1.  ;
  1.  ;RESULT(0) = 1 (Success) ^ 2 (No of questionnaires found)
  1.  ;RESULT(1) = Patient Name: TEST, PATIENT
  1.  ;RESULT(2) = Questionnaire IEN: 20
  1.  ;RESULT(3) = Questionnaire Name: PTSD Survey
  1.  ;RESULT(4) = Date and Time Taken: 8/20/14 3:15pm
  1.  ;RESULT(5) = Date and Time Last Modified: 8/20/14 4:00pm
  1.  ;RESULT(6) = Questions and Answers:
  1.  ;RESULT(7) = Are you a smoker?  Yes
  1.  ;RESULT(8) = How many packs per week?  3
  1.  ;
  1.  ;
  1.  N CNT,NEXTLINE,TDT
  1.  S NEXTLINE=0
  1.  S CNT=0
  1.  ;
  1. STARTHS ;
  1.  K @TARGET
  1.  ; valid input parameters
  1.  ; set up variables for the extraction of clinical survey information
  1.  I $G(VPSDFN)="" S @TARGET@(0)="-1^Patient IEN not sent" G EX
  1.  I '$D(^DPT(VPSDFN)) S @TARGET@(0)="-1^Patient not found" G EX
  1.  I '$D(^VPS(853.8,VPSDFN)) S @TARGET@(0)="-1^There are no questionnaires for this patient" G EX
  1.  ;
  1.  N FDT,FLG,DAT,DATA,X,Y,FLT
  1.  S TDT=$$NOW^XLFDT()+.0001
  1.  S FLG=0
  1.  I $G(VPSTDT) D
  1.  . I VPSTDT["." S TDT=VPSTDT+.0001 Q
  1.  . I VPSTDT'["." S TDT=VPSTDT+1
  1.  S VPSQIEN=$G(VPSQIEN)
  1.  S VPSQNM=$G(VPSQNM)
  1.  S VPSQNM=$$UPCASE^VPSSRVY2(VPSQNM)
  1.  ; loop through obtaining the most current information first
  1.  S FLG=0,TID=0
  1.  F  S TID=$O(^VPS(853.8,VPSDFN,1,TID)) Q:'TID!FLG  D
  1.  . S FDT=TDT
  1.  . F  S FDT=$O(^VPS(853.8,VPSDFN,1,TID,1,FDT),-1) Q:'FDT!FLG  D
  1.  .. I $G(VPSFDT),TDT<VPSFDT Q
  1.  .. I $G(VPSTDT)="",$G(VPSFDT)]"",$G(VPSFDT)'=$P(FDT,".") Q
  1.  .. I $G(VPSNUM),CNT=VPSNUM S FLG=1 Q
  1.  .. I $$PASSCHK(TID,$G(VPSQIEN),$G(VPSQNM)) D
  1.  ... D GETDATA(VPSDFN,TID,FDT,VPSQNM)
  1.  ... S CNT=CNT+1
  1.  I CNT=0 D
  1.  . N STR
  1.  . S STR="No Survey results for "
  1.  . I $G(VPSQIEN)]"" S STR=STR_"CSQ IEN: "_VPSQIEN_", "
  1.  . I $G(VPSQNM)]"" S STR=STR_"CSQ NAME: "_VPSQNM_" "
  1.  . I $G(VPSFDT)]"" S STR=STR_"since "_VPSFDT
  1.  . D ADD(STR)
  1.  S @TARGET@(0)="1^"_CNT
  1.  ;
  1. EX ;
  1.  I $G(VPSHSFLG)=1 Q
  1.  I $G(UTFLG) Q "~@"_$NA(@TARGET)
  1.  D PDO(VPSDFN,.TARGET)
  1.  ;
  1.  Q "~@"_$NA(@TARGET)
  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.  ; obtain the information from the clinical survey
  1.  ; and format the information into the report
  1. GETDATA(VPSDFN,TID,FDT,VPSQNM) ;
  1.  ;
  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="Patient DFN: "_VPSDFN
  1.  ;D ADD(DAT)
  1.  ;S DAT="Patient Name: "_$$GET1^DIQ(2,VPSDFN_",",.01)
  1.  ;D ADD(DAT)
  1.  S DAT="Questionnaire Name: "_$$GET1^DIQ(853.85,TID_",",1)
  1.  D ADD(DAT)
  1.  S DAT="ID: "_$$GET1^DIQ(853.85,TID_",",.01)
  1.  ;D ADD(DAT)
  1.  S DAT=DAT_$J(" ",66-$L(DAT))_"Ver: "_$$GET1^DIQ(853.85,TID_",",2)
  1.  D ADD(DAT)
  1.  ; Obtain Response identifier
  1.  S DAT="Response Identifier: "_$$GET1^DIQ(853.811,"1,"_FDT_","_TID_","_VPSDFN_",",.01)
  1.  D ADD(DAT)
  1.  ; Obtain converted Date and Time Taken
  1.  S DAT="Date/Time Taken: "_$$GET1^DIQ(853.811,"1,"_FDT_","_TID_","_VPSDFN_",",.02)
  1.  ;D ADD(DAT)
  1.  ; Obtain Date and Time Last Modified and convert to external format
  1.  S DAT=DAT_$J(" ",41-$L(DAT))_"Last Modified: "_$$GET1^DIQ(853.811,"1,"_FDT_","_TID_","_VPSDFN_",",.03)
  1.  D ADD(DAT)
  1.  ; Obtain COMPLETION STATUS
  1.  S DAT="Completion Status: "_$$GET1^DIQ(853.811,"1,"_FDT_","_TID_","_VPSDFN_",",.04)
  1.  D ADD(DAT)
  1.  ; Obtain PATIENT SAFETY
  1.  S DAT="Patient Safety: "_$$GET1^DIQ(853.811,"1,"_FDT_","_TID_","_VPSDFN_",",.05)
  1.  S DAT=DAT_$J(" ",41-$L(DAT))_"Immediate Action: "_$$GET1^DIQ(853.811,"1,"_FDT_","_TID_","_VPSDFN_",",.06)
  1.  D ADD(DAT)
  1.  ; Obtain IMMEDIATE ACTION
  1.  ;S DAT="Immediate Action: "_$$GET1^DIQ(853.811,"1,"_FDT_","_TID_","_VPSDFN_",",.06)
  1.  ;D ADD(DAT)
  1.  ; Obtain SURVEY CALCULATED VALUE
  1.  S DAT=$$GET1^DIQ(853.811,"1,"_FDT_","_TID_","_VPSDFN_",",4)
  1.  I $G(CALC),DAT]"" D ADD("Survey Calculated Value: "_DAT)
  1.  S I=0
  1.  N DAT1
  1.  F  S I=$O(^VPS(853.8,VPSDFN,1,TID,1,FDT,1,1,2,I)) Q:'I  D
  1.  . S DAT=$P(^VPS(853.8,VPSDFN,1,TID,1,FDT,1,1,2,I,0),U)
  1.  . I DAT]"" S DAT="Additional Calc Value Name: "_DAT ;D ADD(DAT)
  1.  . S DAT1=$P(^VPS(853.8,VPSDFN,1,TID,1,FDT,1,1,2,I,0),U,2)
  1.  . I DAT1]"" S DAT1="Additional Calc Value Score: "_DAT1 ;D ADD(DAT)
  1.  . I DAT]""!(DAT1]"") S DAT=DAT_$J(" ",41-$L(DAT))_DAT1 D ADD(DAT)
  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="Appointment Check-in: "_^VPS(853.8,VPSDFN,1,TID,1,FDT,1,1,1,I,0)
  1.  . D ADD(DAT)
  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.  . D ADD("______________________________")
  1.  . ;S DAT="Question Number: "_$$GET1^DIQ(853.8113,I_",1,"_FDT_","_TID_","_VPSDFN_",",.01)
  1.  . ;D ADD(DAT)
  1.  . S DAT=$$GET1^DIQ(853.8113,I_",1,"_FDT_","_TID_","_VPSDFN_",",1)
  1.  . I $G(CALC),DAT]"" D ADD("Question Calculated Value: "_DAT)
  1.  . N TMP
  1.  . I $$GET1^DIQ(853.8113,I_",1,"_FDT_","_TID_","_VPSDFN_",",2,"","TMP")
  1.  . I $D(TMP(1)) S TMP(1)=$$GET1^DIQ(853.8113,I_",1,"_FDT_","_TID_","_VPSDFN_",",.01)_" - "_TMP(1)
  1.  . S J=0
  1.  . F  S J=$O(TMP(J)) Q:'J  D ADD(TMP(J))
  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.  .. I CUR'=0,CUR'=$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",1),+$G(AHFLG)=0 S CUR=99 Q
  1.  .. I CUR=0 S CUR=$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",1)
  1.  .. ;D ADD("     _-_-_-_-_-_-_-_-_-_-_-_-_-_-_-")
  1.  .. ; Obtain ANSWER IDENTIFIER
  1.  .. ;S DAT="Answer Identifier: "_$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",.01)
  1.  .. ;D ADD(DAT)
  1.  .. ;S DAT="Interface Used: "_$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",.02)
  1.  .. ;D ADD(DAT)
  1.  .. ;S DAT="Kiosk Identifier: "_$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",3)
  1.  .. ;D ADD(DAT)
  1.  .. ;S DAT="Kiosk Session Identifier: "_$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",4)
  1.  .. ;D ADD(DAT)
  1.  .. ;S DAT="Kiosk Group Identifier: "_$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",5)
  1.  .. ;D ADD(DAT)
  1.  .. S DAT=""
  1.  .. K TMP
  1.  .. I $$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",6,"","TMP")
  1.  .. I $D(TMP(1)) D ADD("   "_$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",.01)_" - "_TMP(1))
  1.  .. S J=1
  1.  .. F  S J=$O(TMP(J)) Q:'J  D ADD("     "_TMP(J))
  1.  .. S DAT=$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",.03)
  1.  .. I DAT'="PATIENT" D
  1.  ... S DAT="    Respondent: "_DAT
  1.  ... ;D ADD("    "_DAT)
  1.  ... S DAT=DAT_$J(" ",41-$L(DAT))_"Respondent Name: "_$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",.04)
  1.  ... D ADD(DAT)
  1.  .. S DAT="    Answer Date/Time: "_$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",1)
  1.  .. ;D ADD("    "_DAT)
  1.  .. S DAT1=$$GET1^DIQ(853.81133,II_","_I_",1,"_FDT_","_TID_","_VPSDFN_",",2)
  1.  .. I DAT1]"",+DAT1=0,DAT1'=0 D
  1.  ... S DAT1="Interviewer Name: "_DAT1
  1.  ... S DAT=DAT_$J(" ",41-$L(DAT))_DAT1
  1.  ... D ADD(DAT)
  1.  .. D ADD("")
  1.  .. S CUR=1
  1.  D ADD("@#END OF SURVEY#@")
  1.  Q
  1. ADD(TXT) ;
  1.  S NEXTLINE=NEXTLINE+1
  1.  S @TARGET@(NEXTLINE)=TXT
  1.  Q
  1.  ;
  1. PDO(PTIEN,PDOARY) ;
  1.  ; create object and store the results of this clinical survey request
  1.  N PDOOREF,LINE,ARR
  1.  S ARR="^TMP(""VPSSRVY3PDO"",$J)"
  1.  S PDOOREF=$$NEW^VPSOBJ(PTIEN,ARR)
  1.  I $P(@PDOARY@(0),U)=-1 D ADDPDO^VPSOBJ(PDOOREF,$P(@TARGET@(0),U,2)) G CLOSE
  1.  S LINE=0
  1.  F  S LINE=$O(@PDOARY@(LINE)) Q:'LINE  D
  1.  . I @PDOARY@(LINE)'="@#END OF SURVEY#@" D ADDPDO^VPSOBJ(PDOOREF,@PDOARY@(LINE)) I 1
  1.  . E  D ADDBLANK^VPSOBJ(PDOOREF),ADDUNDLN^VPSOBJ(PDOOREF),ADDBLANK^VPSOBJ(PDOOREF)
  1. CLOSE ;
  1.  ; close the object
  1.  D CLOSE^VPSOBJ(PDOOREF)
  1.  S PDOARY=ARR
  1.  Q
  1.  ;
  1. HSAHCAL ;
  1.  ; Entry point for including answer history and calculated values with the health summary 
  1.  ; AHFLG - is the flag for obtaining answer history
  1.  N AHFLG
  1.  S AHFLG=1
  1. HSCAL ;
  1.  ; Entry point for including calculated values with the health summary 
  1.  ; CALC - is the flag for obtaining calcualted values
  1.  N CALC
  1.  S CALC=1
  1. HS ;
  1.  ; Entry point for health summary
  1.  ; VPSHSFLG - Flag that indicates health summary so the report is processed accordingly
  1.  ; obtains key values that are provided by the CPRS call
  1.  N VPSHSFLG,LINE,DATA,VPSDFN,TARGET,VPSQIEN,VPSQNM,VPSFDT,VPSTDT,VPSNUM,DIEN
  1.  S VPSHSFLG=1
  1.  S TARGET="^TMP(""VPSSRVY3 HS"",$J)"
  1.  I $G(DFN)]"" S VPSDFN=DFN
  1.  I $G(GMTSBEG)=1 S GMTSBEG=""
  1.  I $G(GMTSEND)=9999999 S GMTSEND=""
  1.  I $G(GMTSNDM)=-1 S GMTSNDM=""
  1.  I $G(GMTSNDM)]"" S VPSNUM=GMTSNDM
  1.  I $G(GMTSBEG)]"" S VPSFDT=GMTSBEG
  1.  I $G(GMTSEND)]"" S VPSTDT=GMTSEND
  1.  W !,$$CJ^XLFSTR(GMTSEGH,75),!
  1.  N CNT,NEXTLINE,I
  1.  S NEXTLINE=0,CNT=0
  1.  I '$D(GMTSEG(1,853.875)) D STARTHS,PRINTHS("") Q
  1.  S I=0
  1.  F  S I=$O(GMTSEG(1,853.875,I)) Q:'I  D
  1.  . S DIEN=$G(GMTSEG(1,853.875,I))
  1.  . S VPSQNM=$P($G(^VPS(853.875,DIEN,0)),U)
  1.  . S CNT=0
  1.  . D STARTHS
  1.  . D PRINTHS(VPSQNM_" - "_GMTSEGL)
  1.  Q
  1.  ;
  1.  ; print the results of the health summary
  1.  ;
  1. PRINTHS(SURVEY) ;
  1.  N LINE
  1.  W $$REPEAT^XLFSTR("_",75),!,$$CJ^XLFSTR(SURVEY,75),!,!
  1.  I $P(@TARGET@(0),U)=-1 W !,$P(@TARGET@(0),U,2) Q
  1.  I $P(@TARGET@(0),U,2)=0 W !,"No results",!,$$REPEAT^XLFSTR("_",75),! Q
  1.  S LINE=0
  1.  F  S LINE=$O(@TARGET@(LINE)) Q:'LINE  D
  1.  . S DATA=@TARGET@(LINE)
  1.  . I DATA'="@#END OF SURVEY#@" W !,DATA
  1.  . E  W !,$$REPEAT^XLFSTR("_",75),!
  1.  Q