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

YTQRCRW.m

Go to the documentation of this file.
  1. YTQRCRW ;SLC/KCM - MH Clinical Reminder Dialog Web Calls ; 1/25/2017
  1. ;;5.01;MENTAL HEALTH;**223**;Dec 30, 1994;Build 22
  1. ;
  1. ; REST Calls re-routed here if assignmentId matches GUID pattern
  1. ;
  1. ; ^XTMP(YTQCPRS-guid,1,property)=ASSIGNMENT property value
  1. ; ^XTMP(YTQCPRS-guid,1,"instrument",n,property)=specific instrument values
  1. ; ^XTMP(YTQCPRS-guid,3,testId,property)=ADMIN property value (replace 601.94)
  1. ; ^XTMP(YTQCPRS-guid,3,testId,"answers",n,property)=response value for admin
  1. ; ^XTMP(YTQCPRS-guid,"hwnd")=client windows handle
  1. ; ^XTMP(YTQCPRS-HWND,hwnd,dfn,testName)=guid^date ; INDEX for patient/session
  1. ;
  1. GETASMT ;(ARGS,RESULTS) -- from ASMTBYID^YTQRQAD1
  1. ; web: GET /api/mha/assignment/:assignmentId?36ANP
  1. ; get assignment from staging by GUID
  1. ; ARGS("assignmentId")=GUID
  1. N NODE,TEST,I
  1. S NODE="YTQCPRS-"_$G(ARGS("assignmentId"))
  1. I '$D(^XTMP(NODE)) D SETERROR^YTQRUTL(404,"Not Found: "_ARGS("assignmentId")) QUIT
  1. S I=0 F S I=$O(^XTMP(NODE,1,"instruments",I)) Q:'I D
  1. . S TEST=$G(^XTMP(NODE,1,"instruments",I,"id"))
  1. . I 'TEST S TEST=$O(^YTT(601.71,^XTMP(NODE,1,"instruments",I,"name"),0))
  1. . S ^XTMP(NODE,1,"instruments",I,"progress")=$$PROGRESS(NODE,TEST)
  1. M RESULTS=^XTMP(NODE,1)
  1. Q
  1. DELASMT ; (ARGS) -- from DELTEST^YTQRQAD1
  1. ; web: DELETE /api/mha/assignment/:assignmentId/:instrument/:delfrmassign
  1. ; remove an instrument from an assignment
  1. ; if delfrmassign=NO just reset the admin (progress=0, adminId=null)
  1. ; ARGS("assignmentId")=GUID
  1. ; ARGS("instrument")=instrument name (optionally can be IEN)
  1. ; ARGS("delfrmassign")=YES or NO (default=YES)
  1. N NODE,DFA,TSTLST,I,TEST
  1. S NODE=$G(ARGS("assignmentId"))
  1. I $D(^XTMP(NODE))<10 D SETERROR^YTQRUTL(404,"Assignment not found") QUIT
  1. S DFA=$G(ARGS("delfrmassign")) S:DFA'="NO" DFA="YES"
  1. S TSTLST=$G(ARGS("instrument"))
  1. I '$L(TSTLST) D SETERROR^YTQRUTL(404,"Instrument for deletion not sent") QUIT
  1. F I=1:1:$L(TSTLST,",") S TEST=$P(TSTLST,",",I) D RMVTEST(NODE,TEST,DFA)
  1. Q
  1. ;
  1. RMVTEST(NODE,TEST,DFA) ; remove a test from an assignment
  1. ; DFA="YES" means delete from assignment
  1. N TESTNM,I,DFN
  1. I TEST'=+TEST S TEST=$O(^YTT(601.71,"B",TEST,0)) Q:'TEST
  1. I 'TEST D SETERROR^YTQRUTL(404,"Instrument not found") QUIT
  1. S TESTNM=$P(^YTT(601.71,TEST,0),U)
  1. K ^XTMP(NODE,3,TEST) ; remove administration data
  1. S I=1 F S I=$O(^XTMP(NODE,1,"instruments",I)) Q:'I D
  1. . I ^XTMP(NODE,1,"instruments",I,"name")'=TESTNM QUIT
  1. . ; delete or reset named instrument (based on DFA)
  1. . I DFA="YES" K ^XTMP(NODE,1,"instruments",I) I 1
  1. . E S ^XTMP(NODE,1,"instruments",I,"adminId")="null",^("complete")="false",^("progress")=0
  1. ; delete assignment if empty
  1. I $D(^XTMP(NODE,1,"instruments"))<10 D
  1. . S DFN=+$G(^XTMP(NODE,1,"patient","dfn"))
  1. . N HWND S HWND=$G(^XTMP(NODE,"hwnd"),0)
  1. . K ^XTMP(NODE),^XTMP("YTQCPRS-HWND",HWND,DFN,TESTNM)
  1. Q
  1. GETADM ;(ARGS,RESULTS) -- from GETADM^YTQRQAD2
  1. ; web: GET /api/mha/instrument/admin/:adminId?36ANP1"-".N
  1. ; get the current state (answers) for an administration
  1. ; ARGS("adminId")=GUID-TestIEN
  1. N GUID,TEST,NODE,I
  1. S GUID=$P(ARGS("adminId"),"-",1,5)
  1. S TEST=$P(ARGS("adminId"),"-",6)
  1. S NODE="YTQCPRS-"_GUID
  1. I '$D(^XTMP(NODE,3,TEST)) D SETERROR^YTQRUTL(404,"Not Found: "_ARGS("adminId")) QUIT
  1. M RESULTS=^XTMP(NODE,3,TEST)
  1. S I=0 F S I=$O(RESULTS("answers",I)) Q:'I D
  1. . I $G(RESULTS("answers",I,"value"))="NOT ASKED" S RESULTS("answers",I,"value")="null"
  1. S RESULTS("progress")=$$PROGRESS(NODE,TEST)
  1. Q
  1. POSTADM ;(ARGS,DATA) -- from SAVEADM^YTQRQAD2
  1. ; web: POST /api/mha/instrument/admin
  1. ; return adminId = GUID-TestIEN, save responses in temporary space
  1. N GUID,NODE,TEST,ADMIN,SAVE,I
  1. S GUID=$G(DATA("assignmentId")),NODE="YTQCPRS-"_GUID
  1. I '$D(^XTMP(NODE,1)) D SETERROR^YTQRUTL(404,"Not Found: "_GUID) QUIT ""
  1. S TEST=+$G(DATA("instrumentId"))
  1. I 'TEST D SETERROR^YTQRUTL(500,"Answers not saved") QUIT ""
  1. S ADMIN=GUID_"-"_TEST
  1. K ^XTMP(NODE,3,TEST)
  1. S ^XTMP(NODE,3,TEST,"adminId")=ADMIN
  1. S ^XTMP(NODE,3,TEST,"complete")=$G(DATA("complete"),"false")
  1. S ^XTMP(NODE,3,TEST,"instrumentId")=TEST
  1. S I=0 F S I=$O(^XTMP(NODE,1,"instruments",I)) Q:'I D
  1. . I ^XTMP(NODE,1,"instruments",I,"id")'=TEST QUIT
  1. . S ^XTMP(NODE,1,"instruments",I,"adminId")=ADMIN
  1. N QID,VAL,SEQ,QTOT,QANS
  1. S (SEQ,QTOT,QANS)=0
  1. S I=0 F S I=$O(DATA("answers",I)) Q:'I D
  1. . S QID=DATA("answers",I,"id")
  1. . M VAL=DATA("answers",I,"value")
  1. . QUIT:$E(QID)'="q" ; skip intros, sections
  1. . I $G(VAL)="null" S VAL="NOT ASKED"
  1. . S QTOT=QTOT+1 I VAL'="NOT ASKED" S QANS=QANS+1
  1. . S SEQ=SEQ+1
  1. . S ^XTMP(NODE,3,TEST,"answers",SEQ,"id")=QID
  1. . M ^XTMP(NODE,3,TEST,"answers",SEQ,"value")=VAL
  1. Q "/api/mha/instrument/admin/"_ADMIN
  1. ;
  1. PROGRESS(NODE,TEST) ; return progress for TEST at NODE
  1. N I,QTOT,QANS,TESTNM,PERCENT
  1. S TESTNM=$P(^YTT(601.71,TEST,0),U)
  1. S (I,QTOT)=0 F S I=$O(^YTT(601.76,"AC",TEST,I)) Q:'I S QTOT=QTOT+1
  1. S (I,QANS)=0 F S I=$O(^XTMP(NODE,3,TEST,"answers",I)) Q:'I I ^(I,"value")'="NOT ASKED" S QANS=QANS+1
  1. S PERCENT=$S(QTOT>0:+$P(((QANS/QTOT)*100)+.5,"."),1:0)
  1. I $G(^XTMP(NODE,3,TEST,"complete"))="true" S PERCENT=100
  1. I $E(TESTNM,1,4)="CAT-"!($E(TESTNM,1,4)="CAD-") D
  1. . N CATINVW S CATINVW=$O(^YTT(601.71,"B","CAT-CAD Interview",0))
  1. . I $G(^XTMP(NODE,1,"catInfo","credentials","interviewID")) S PERCENT=10
  1. . I $G(^XTMP(NODE,3,CATINVW,"complete"))="true" S PERCENT=100
  1. Q PERCENT