YTQRCRW ;SLC/KCM - MH Clinical Reminder Dialog Web Calls ; 1/25/2017
;;5.01;MENTAL HEALTH;**223**;Dec 30, 1994;Build 22
;
; REST Calls re-routed here if assignmentId matches GUID pattern
;
; ^XTMP(YTQCPRS-guid,1,property)=ASSIGNMENT property value
; ^XTMP(YTQCPRS-guid,1,"instrument",n,property)=specific instrument values
; ^XTMP(YTQCPRS-guid,3,testId,property)=ADMIN property value (replace 601.94)
; ^XTMP(YTQCPRS-guid,3,testId,"answers",n,property)=response value for admin
; ^XTMP(YTQCPRS-guid,"hwnd")=client windows handle
; ^XTMP(YTQCPRS-HWND,hwnd,dfn,testName)=guid^date ; INDEX for patient/session
;
GETASMT ;(ARGS,RESULTS) -- from ASMTBYID^YTQRQAD1
; web: GET /api/mha/assignment/:assignmentId?36ANP
; get assignment from staging by GUID
; ARGS("assignmentId")=GUID
N NODE,TEST,I
S NODE="YTQCPRS-"_$G(ARGS("assignmentId"))
I '$D(^XTMP(NODE)) D SETERROR^YTQRUTL(404,"Not Found: "_ARGS("assignmentId")) QUIT
S I=0 F S I=$O(^XTMP(NODE,1,"instruments",I)) Q:'I D
. S TEST=$G(^XTMP(NODE,1,"instruments",I,"id"))
. I 'TEST S TEST=$O(^YTT(601.71,^XTMP(NODE,1,"instruments",I,"name"),0))
. S ^XTMP(NODE,1,"instruments",I,"progress")=$$PROGRESS(NODE,TEST)
M RESULTS=^XTMP(NODE,1)
Q
DELASMT ; (ARGS) -- from DELTEST^YTQRQAD1
; web: DELETE /api/mha/assignment/:assignmentId/:instrument/:delfrmassign
; remove an instrument from an assignment
; if delfrmassign=NO just reset the admin (progress=0, adminId=null)
; ARGS("assignmentId")=GUID
; ARGS("instrument")=instrument name (optionally can be IEN)
; ARGS("delfrmassign")=YES or NO (default=YES)
N NODE,DFA,TSTLST,I,TEST
S NODE=$G(ARGS("assignmentId"))
I $D(^XTMP(NODE))<10 D SETERROR^YTQRUTL(404,"Assignment not found") QUIT
S DFA=$G(ARGS("delfrmassign")) S:DFA'="NO" DFA="YES"
S TSTLST=$G(ARGS("instrument"))
I '$L(TSTLST) D SETERROR^YTQRUTL(404,"Instrument for deletion not sent") QUIT
F I=1:1:$L(TSTLST,",") S TEST=$P(TSTLST,",",I) D RMVTEST(NODE,TEST,DFA)
Q
;
RMVTEST(NODE,TEST,DFA) ; remove a test from an assignment
; DFA="YES" means delete from assignment
N TESTNM,I,DFN
I TEST'=+TEST S TEST=$O(^YTT(601.71,"B",TEST,0)) Q:'TEST
I 'TEST D SETERROR^YTQRUTL(404,"Instrument not found") QUIT
S TESTNM=$P(^YTT(601.71,TEST,0),U)
K ^XTMP(NODE,3,TEST) ; remove administration data
S I=1 F S I=$O(^XTMP(NODE,1,"instruments",I)) Q:'I D
. I ^XTMP(NODE,1,"instruments",I,"name")'=TESTNM QUIT
. ; delete or reset named instrument (based on DFA)
. I DFA="YES" K ^XTMP(NODE,1,"instruments",I) I 1
. E S ^XTMP(NODE,1,"instruments",I,"adminId")="null",^("complete")="false",^("progress")=0
; delete assignment if empty
I $D(^XTMP(NODE,1,"instruments"))<10 D
. S DFN=+$G(^XTMP(NODE,1,"patient","dfn"))
. N HWND S HWND=$G(^XTMP(NODE,"hwnd"),0)
. K ^XTMP(NODE),^XTMP("YTQCPRS-HWND",HWND,DFN,TESTNM)
Q
GETADM ;(ARGS,RESULTS) -- from GETADM^YTQRQAD2
; web: GET /api/mha/instrument/admin/:adminId?36ANP1"-".N
; get the current state (answers) for an administration
; ARGS("adminId")=GUID-TestIEN
N GUID,TEST,NODE,I
S GUID=$P(ARGS("adminId"),"-",1,5)
S TEST=$P(ARGS("adminId"),"-",6)
S NODE="YTQCPRS-"_GUID
I '$D(^XTMP(NODE,3,TEST)) D SETERROR^YTQRUTL(404,"Not Found: "_ARGS("adminId")) QUIT
M RESULTS=^XTMP(NODE,3,TEST)
S I=0 F S I=$O(RESULTS("answers",I)) Q:'I D
. I $G(RESULTS("answers",I,"value"))="NOT ASKED" S RESULTS("answers",I,"value")="null"
S RESULTS("progress")=$$PROGRESS(NODE,TEST)
Q
POSTADM ;(ARGS,DATA) -- from SAVEADM^YTQRQAD2
; web: POST /api/mha/instrument/admin
; return adminId = GUID-TestIEN, save responses in temporary space
N GUID,NODE,TEST,ADMIN,SAVE,I
S GUID=$G(DATA("assignmentId")),NODE="YTQCPRS-"_GUID
I '$D(^XTMP(NODE,1)) D SETERROR^YTQRUTL(404,"Not Found: "_GUID) QUIT ""
S TEST=+$G(DATA("instrumentId"))
I 'TEST D SETERROR^YTQRUTL(500,"Answers not saved") QUIT ""
S ADMIN=GUID_"-"_TEST
K ^XTMP(NODE,3,TEST)
S ^XTMP(NODE,3,TEST,"adminId")=ADMIN
S ^XTMP(NODE,3,TEST,"complete")=$G(DATA("complete"),"false")
S ^XTMP(NODE,3,TEST,"instrumentId")=TEST
S I=0 F S I=$O(^XTMP(NODE,1,"instruments",I)) Q:'I D
. I ^XTMP(NODE,1,"instruments",I,"id")'=TEST QUIT
. S ^XTMP(NODE,1,"instruments",I,"adminId")=ADMIN
N QID,VAL,SEQ,QTOT,QANS
S (SEQ,QTOT,QANS)=0
S I=0 F S I=$O(DATA("answers",I)) Q:'I D
. S QID=DATA("answers",I,"id")
. M VAL=DATA("answers",I,"value")
. QUIT:$E(QID)'="q" ; skip intros, sections
. I $G(VAL)="null" S VAL="NOT ASKED"
. S QTOT=QTOT+1 I VAL'="NOT ASKED" S QANS=QANS+1
. S SEQ=SEQ+1
. S ^XTMP(NODE,3,TEST,"answers",SEQ,"id")=QID
. M ^XTMP(NODE,3,TEST,"answers",SEQ,"value")=VAL
Q "/api/mha/instrument/admin/"_ADMIN
;
PROGRESS(NODE,TEST) ; return progress for TEST at NODE
N I,QTOT,QANS,TESTNM,PERCENT
S TESTNM=$P(^YTT(601.71,TEST,0),U)
S (I,QTOT)=0 F S I=$O(^YTT(601.76,"AC",TEST,I)) Q:'I S QTOT=QTOT+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
S PERCENT=$S(QTOT>0:+$P(((QANS/QTOT)*100)+.5,"."),1:0)
I $G(^XTMP(NODE,3,TEST,"complete"))="true" S PERCENT=100
I $E(TESTNM,1,4)="CAT-"!($E(TESTNM,1,4)="CAD-") D
. N CATINVW S CATINVW=$O(^YTT(601.71,"B","CAT-CAD Interview",0))
. I $G(^XTMP(NODE,1,"catInfo","credentials","interviewID")) S PERCENT=10
. I $G(^XTMP(NODE,3,CATINVW,"complete"))="true" S PERCENT=100
Q PERCENT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQRCRW 5392 printed Apr 09, 2024@21:19:14 Page 2
YTQRCRW ;SLC/KCM - MH Clinical Reminder Dialog Web Calls ; 1/25/2017
+1 ;;5.01;MENTAL HEALTH;**223**;Dec 30, 1994;Build 22
+2 ;
+3 ; REST Calls re-routed here if assignmentId matches GUID pattern
+4 ;
+5 ; ^XTMP(YTQCPRS-guid,1,property)=ASSIGNMENT property value
+6 ; ^XTMP(YTQCPRS-guid,1,"instrument",n,property)=specific instrument values
+7 ; ^XTMP(YTQCPRS-guid,3,testId,property)=ADMIN property value (replace 601.94)
+8 ; ^XTMP(YTQCPRS-guid,3,testId,"answers",n,property)=response value for admin
+9 ; ^XTMP(YTQCPRS-guid,"hwnd")=client windows handle
+10 ; ^XTMP(YTQCPRS-HWND,hwnd,dfn,testName)=guid^date ; INDEX for patient/session
+11 ;
GETASMT ;(ARGS,RESULTS) -- from ASMTBYID^YTQRQAD1
+1 ; web: GET /api/mha/assignment/:assignmentId?36ANP
+2 ; get assignment from staging by GUID
+3 ; ARGS("assignmentId")=GUID
+4 NEW NODE,TEST,I
+5 SET NODE="YTQCPRS-"_$GET(ARGS("assignmentId"))
+6 IF '$DATA(^XTMP(NODE))
DO SETERROR^YTQRUTL(404,"Not Found: "_ARGS("assignmentId"))
QUIT
+7 SET I=0
FOR
SET I=$ORDER(^XTMP(NODE,1,"instruments",I))
if 'I
QUIT
Begin DoDot:1
+8 SET TEST=$GET(^XTMP(NODE,1,"instruments",I,"id"))
+9 IF 'TEST
SET TEST=$ORDER(^YTT(601.71,^XTMP(NODE,1,"instruments",I,"name"),0))
+10 SET ^XTMP(NODE,1,"instruments",I,"progress")=$$PROGRESS(NODE,TEST)
End DoDot:1
+11 MERGE RESULTS=^XTMP(NODE,1)
+12 QUIT
DELASMT ; (ARGS) -- from DELTEST^YTQRQAD1
+1 ; web: DELETE /api/mha/assignment/:assignmentId/:instrument/:delfrmassign
+2 ; remove an instrument from an assignment
+3 ; if delfrmassign=NO just reset the admin (progress=0, adminId=null)
+4 ; ARGS("assignmentId")=GUID
+5 ; ARGS("instrument")=instrument name (optionally can be IEN)
+6 ; ARGS("delfrmassign")=YES or NO (default=YES)
+7 NEW NODE,DFA,TSTLST,I,TEST
+8 SET NODE=$GET(ARGS("assignmentId"))
+9 IF $DATA(^XTMP(NODE))<10
DO SETERROR^YTQRUTL(404,"Assignment not found")
QUIT
+10 SET DFA=$GET(ARGS("delfrmassign"))
if DFA'="NO"
SET DFA="YES"
+11 SET TSTLST=$GET(ARGS("instrument"))
+12 IF '$LENGTH(TSTLST)
DO SETERROR^YTQRUTL(404,"Instrument for deletion not sent")
QUIT
+13 FOR I=1:1:$LENGTH(TSTLST,",")
SET TEST=$PIECE(TSTLST,",",I)
DO RMVTEST(NODE,TEST,DFA)
+14 QUIT
+15 ;
RMVTEST(NODE,TEST,DFA) ; remove a test from an assignment
+1 ; DFA="YES" means delete from assignment
+2 NEW TESTNM,I,DFN
+3 IF TEST'=+TEST
SET TEST=$ORDER(^YTT(601.71,"B",TEST,0))
if 'TEST
QUIT
+4 IF 'TEST
DO SETERROR^YTQRUTL(404,"Instrument not found")
QUIT
+5 SET TESTNM=$PIECE(^YTT(601.71,TEST,0),U)
+6 ; remove administration data
KILL ^XTMP(NODE,3,TEST)
+7 SET I=1
FOR
SET I=$ORDER(^XTMP(NODE,1,"instruments",I))
if 'I
QUIT
Begin DoDot:1
+8 IF ^XTMP(NODE,1,"instruments",I,"name")'=TESTNM
QUIT
+9 ; delete or reset named instrument (based on DFA)
+10 IF DFA="YES"
KILL ^XTMP(NODE,1,"instruments",I)
IF 1
+11 IF '$TEST
SET ^XTMP(NODE,1,"instruments",I,"adminId")="null"
SET ^("complete")="false"
SET ^("progress")=0
End DoDot:1
+12 ; delete assignment if empty
+13 IF $DATA(^XTMP(NODE,1,"instruments"))<10
Begin DoDot:1
+14 SET DFN=+$GET(^XTMP(NODE,1,"patient","dfn"))
+15 NEW HWND
SET HWND=$GET(^XTMP(NODE,"hwnd"),0)
+16 KILL ^XTMP(NODE),^XTMP("YTQCPRS-HWND",HWND,DFN,TESTNM)
End DoDot:1
+17 QUIT
GETADM ;(ARGS,RESULTS) -- from GETADM^YTQRQAD2
+1 ; web: GET /api/mha/instrument/admin/:adminId?36ANP1"-".N
+2 ; get the current state (answers) for an administration
+3 ; ARGS("adminId")=GUID-TestIEN
+4 NEW GUID,TEST,NODE,I
+5 SET GUID=$PIECE(ARGS("adminId"),"-",1,5)
+6 SET TEST=$PIECE(ARGS("adminId"),"-",6)
+7 SET NODE="YTQCPRS-"_GUID
+8 IF '$DATA(^XTMP(NODE,3,TEST))
DO SETERROR^YTQRUTL(404,"Not Found: "_ARGS("adminId"))
QUIT
+9 MERGE RESULTS=^XTMP(NODE,3,TEST)
+10 SET I=0
FOR
SET I=$ORDER(RESULTS("answers",I))
if 'I
QUIT
Begin DoDot:1
+11 IF $GET(RESULTS("answers",I,"value"))="NOT ASKED"
SET RESULTS("answers",I,"value")="null"
End DoDot:1
+12 SET RESULTS("progress")=$$PROGRESS(NODE,TEST)
+13 QUIT
POSTADM ;(ARGS,DATA) -- from SAVEADM^YTQRQAD2
+1 ; web: POST /api/mha/instrument/admin
+2 ; return adminId = GUID-TestIEN, save responses in temporary space
+3 NEW GUID,NODE,TEST,ADMIN,SAVE,I
+4 SET GUID=$GET(DATA("assignmentId"))
SET NODE="YTQCPRS-"_GUID
+5 IF '$DATA(^XTMP(NODE,1))
DO SETERROR^YTQRUTL(404,"Not Found: "_GUID)
QUIT ""
+6 SET TEST=+$GET(DATA("instrumentId"))
+7 IF 'TEST
DO SETERROR^YTQRUTL(500,"Answers not saved")
QUIT ""
+8 SET ADMIN=GUID_"-"_TEST
+9 KILL ^XTMP(NODE,3,TEST)
+10 SET ^XTMP(NODE,3,TEST,"adminId")=ADMIN
+11 SET ^XTMP(NODE,3,TEST,"complete")=$GET(DATA("complete"),"false")
+12 SET ^XTMP(NODE,3,TEST,"instrumentId")=TEST
+13 SET I=0
FOR
SET I=$ORDER(^XTMP(NODE,1,"instruments",I))
if 'I
QUIT
Begin DoDot:1
+14 IF ^XTMP(NODE,1,"instruments",I,"id")'=TEST
QUIT
+15 SET ^XTMP(NODE,1,"instruments",I,"adminId")=ADMIN
End DoDot:1
+16 NEW QID,VAL,SEQ,QTOT,QANS
+17 SET (SEQ,QTOT,QANS)=0
+18 SET I=0
FOR
SET I=$ORDER(DATA("answers",I))
if 'I
QUIT
Begin DoDot:1
+19 SET QID=DATA("answers",I,"id")
+20 MERGE VAL=DATA("answers",I,"value")
+21 ; skip intros, sections
if $EXTRACT(QID)'="q"
QUIT
+22 IF $GET(VAL)="null"
SET VAL="NOT ASKED"
+23 SET QTOT=QTOT+1
IF VAL'="NOT ASKED"
SET QANS=QANS+1
+24 SET SEQ=SEQ+1
+25 SET ^XTMP(NODE,3,TEST,"answers",SEQ,"id")=QID
+26 MERGE ^XTMP(NODE,3,TEST,"answers",SEQ,"value")=VAL
End DoDot:1
+27 QUIT "/api/mha/instrument/admin/"_ADMIN
+28 ;
PROGRESS(NODE,TEST) ; return progress for TEST at NODE
+1 NEW I,QTOT,QANS,TESTNM,PERCENT
+2 SET TESTNM=$PIECE(^YTT(601.71,TEST,0),U)
+3 SET (I,QTOT)=0
FOR
SET I=$ORDER(^YTT(601.76,"AC",TEST,I))
if 'I
QUIT
SET QTOT=QTOT+1
+4 SET (I,QANS)=0
FOR
SET I=$ORDER(^XTMP(NODE,3,TEST,"answers",I))
if 'I
QUIT
IF ^(I,"value")'="NOT ASKED"
SET QANS=QANS+1
+5 SET PERCENT=$SELECT(QTOT>0:+$PIECE(((QANS/QTOT)*100)+.5,"."),1:0)
+6 IF $GET(^XTMP(NODE,3,TEST,"complete"))="true"
SET PERCENT=100
+7 IF $EXTRACT(TESTNM,1,4)="CAT-"!($EXTRACT(TESTNM,1,4)="CAD-")
Begin DoDot:1
+8 NEW CATINVW
SET CATINVW=$ORDER(^YTT(601.71,"B","CAT-CAD Interview",0))
+9 IF $GET(^XTMP(NODE,1,"catInfo","credentials","interviewID"))
SET PERCENT=10
+10 IF $GET(^XTMP(NODE,3,CATINVW,"complete"))="true"
SET PERCENT=100
End DoDot:1
+11 QUIT PERCENT
