- 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 Feb 18, 2025@23:45:05 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