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

BQIPLRT1.m

Go to the documentation of this file.
  1. BQIPLRT1 ;PRXM/HC/DB-Retrieve Panel Related Tables ; 19 Oct 2005 12:26 PM
  1. ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1. Q
  1. ;
  1. SRCTYP(DATA,FAKE) ; EP -- BQI GET SOURCE TYPE LIST
  1. ;
  1. ;Description:
  1. ; Return the list of acceptable Source Types associated with a Panel
  1. ;
  1. ;RPC: BQI GET SOURCE TYPE LIST
  1. ;
  1. ;Input:
  1. ; FAKE - extra 'blank' parameter required by BMXNET async 'feature'
  1. ;
  1. ;Output:
  1. ; ^TMP("BQIPLRT1",UID,"SRC") - Name of global (passed by reference) in which the data is stored.
  1. ;
  1. ; ^TMP("BQIPLRT1",UID,"SRC",#) = Source Code ^ Source Description
  1. ; where UID will be either $J or "Z" plus the Task
  1. ;'P' FOR Predefined
  1. ;'Q' FOR QMAN
  1. ;'M' FOR Manual
  1. ;'Y' FOR My Patients
  1. ;'E' FOR EZ Search ; *** will not be implemented for Phase 1
  1. ;'T' FOR Taxonomy ; *** will not be implemented for Phase 1
  1. ;
  1. N UID,X,BQII,II,SET
  1. S BQII=0
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1. S DATA=$NA(^TMP("BQIPLRT1",UID,"SRC"))
  1. K @DATA
  1. ;
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERRSRC^BQIPLRT1 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1. S BQII=BQII+1,@DATA@(BQII)="T00001CODE^T00030DESCRIPTION"_$C(30) ;Header
  1. ;Retrieve set of codes for Source Type
  1. D FIELD^DID(90505.01,.03,,"POINTER","SET")
  1. F II=1:1:$L(SET("POINTER"),";") D
  1. . S BQII=BQII+1,@DATA@(BQII)=$TR($P(SET("POINTER"),";",II),":","^")_$C(30)
  1. S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1. Q
  1. ;
  1. ERRSRC ;Error trap for Source Type
  1. D ^%ZTER
  1. NEW Y,ERRDTM
  1. S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1. S BMXSEC="Recording that an error occurred at "_ERRDTM
  1. I $D(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1. Q
  1. ;
  1. PP(DATA,FAKE) ; EP -- BQI GET PREDEF PANEL LIST
  1. ;
  1. ;Description:
  1. ; Return the list of active Pre-Defined panels
  1. ;
  1. ;RPC: BQI GET PREDEF PANEL LIST
  1. ;
  1. ;Input:
  1. ; FAKE - extra 'blank' parameter required by BMXNET async 'feature'
  1. ;Output:
  1. ; ^TMP("BQIPLRT1",UID,"PP") - Name of global (passed by reference) in which the data is stored.
  1. ;
  1. ; ^TMP("BQIPLRT1",UID,"PP",#) = Pre-Defined IEN ^ Pre-Defined Name ^ Pre-Defined Description
  1. ; where UID will be either $J or "Z" plus the Task
  1. ;
  1. N UID,X,BQII,PPIEN,NM,DESC,STAT,TYPE
  1. S BQII=0
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1. S DATA=$NA(^TMP("BQIPLRT1",UID,"PP"))
  1. K @DATA
  1. ;
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERRPP^BQIPLRT1 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1. ;
  1. ;Set header node
  1. S BQII=BQII+1,@DATA@(BQII)="I00010PREDEF_IEN^T00030PREDEF_NAME^T00001PREDEF_TYPE^T00250PREDEF_DESC"_$C(30)
  1. ;Loop through PreDefined Panels File and retrieve data
  1. S PPIEN=0
  1. F S PPIEN=$O(^BQI(90506,PPIEN)) Q:'PPIEN D
  1. . S STAT=$$GET1^DIQ(90506,PPIEN_",",.02,"I") I STAT Q ; Inactive panel
  1. . S NM=$$GET1^DIQ(90506,PPIEN_",",.01,"I")
  1. . S TYPE=$$GET1^DIQ(90506,PPIEN_",",.04,"I")
  1. . S DESC=$$GET1^DIQ(90506,PPIEN_",",1,"I")
  1. . S BQII=BQII+1,@DATA@(BQII)=PPIEN_"^"_NM_"^"_TYPE_"^"_DESC_$C(30)
  1. S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1. Q
  1. ;
  1. ERRPP ;Error trap for PreDefined Panel
  1. D ^%ZTER
  1. NEW Y,ERRDTM
  1. S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1. S BMXSEC="Recording that an error occurred at "_ERRDTM
  1. I $D(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1. Q
  1. ;
  1. USRQLST(DATA,FAKE) ; EP -- BQI GET QMAN TEMPLATE LIST
  1. ;
  1. ; Input
  1. ; FAKE - extra 'blank' parameter required by BMXNET async 'feature'
  1. ; Output
  1. ; ^TMP("BQIPLRT1",UID,"QT",#)=TEMPLATE IEN_^_TEMPLATE NAME_"^"_FILE NUMBER
  1. ;
  1. ; Variables
  1. ; UID - Unique ID for passing data to and from the GUI
  1. ; CLINKEY - IEN for AMQQZCLIN key
  1. ; SRTTEMP - Sort template IEN
  1. ; TEMPUSER - User associated with a template
  1. ; BQII - Increment variable for setting Output nodes
  1. ; FILE - Used to hold the file number for the Patient and Visit files
  1. ; TEMPNM - Template Name
  1. ; CHKTEMP - Used to check if the template has any patients associated with them.
  1. ;
  1. N UID,CLINKEY,SRTTEMP,TEMPUSER,BQII,FILE,TEMPNM,CHKTEMP,USER,CREATBY,SCOMPDT,FILNM
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J),BQII=0,U="^"
  1. S DATA=$NA(^TMP("BQIPLRT1",UID,"QT"))
  1. K @DATA
  1. ;
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERRQT^BQIPLRT1 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1. ;
  1. S BQII=BQII+1,@DATA@(BQII)="I00010QMAN_IEN^T00085QMAN_TEMPLATE_NAME"_$C(30)
  1. ;THIS CODE HAS BEEN COMMENTED OUT PENDING ANSWERS FROM IHS.
  1. ;
  1. ;If this code is ever added back, also check BQIULSC which contains the start
  1. ;of a generic function for checking security keys for a user.
  1. ;
  1. ;S CLINKEY=$O(^DIC(19.1,"B","AMQQZCLIN","")) Q:CLINKEY=""
  1. ; If this user does not have the AMQQZCLIN security key, find only those
  1. ; templates that were created by this user.
  1. ;I '$D(^VA(200,DUZ,51,CLINKEY)) D Q
  1. ;.F FILE="F9000001","F9000010" D
  1. ;.S TEMPNM=""
  1. ;.F S TEMPNM=$O(^DIBT(FILE,TEMPNM)) Q:TEMPNM="" D
  1. ;..S SRTTEMP=$O(^DIBT(FILE,TEMPNM,"")) Q:'SRTTEMP
  1. ;..S CHKTEMP=$O(^DIBT(SRTTEMP,1,"")) I 'CHKTEMP Q
  1. ;..S TEMPUSER=$$GET1^DIQ(.401,SRTTEMP,5,"I")
  1. ;..Q:TEMPUSER'=DUZ
  1. ;..S BQII=BQII+1
  1. ;..S @DATA@(BQII)=SRTTEMP_U_TEMPNM_U_FILE_$C(30)
  1. ;.S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1. ;
  1. ;
  1. ; If this user does have the AMQQZCLIN security key, create a list of ALL
  1. ; sort templates.
  1. ;
  1. F FILE="F9000001","F9000010" D
  1. .S TEMPNM=""
  1. .F S TEMPNM=$O(^DIBT(FILE,TEMPNM)) Q:TEMPNM="" D
  1. ..S SRTTEMP=0
  1. ..F S SRTTEMP=$O(^DIBT(FILE,TEMPNM,SRTTEMP)) Q:'SRTTEMP D
  1. ...; Check if there are any patients in the template, if not, quit
  1. ...S CHKTEMP=$O(^DIBT(SRTTEMP,1,"")) I 'CHKTEMP Q
  1. ...S USER=$$GET1^DIQ(.401,SRTTEMP,5,"I")
  1. ...S FILNM=$E($$GET1^DIQ(.401,SRTTEMP,4,"E"),1)
  1. ...S CREATBY=$$GET1^DIQ(200,USER,.01,"E")
  1. ...S SCOMPDT=$$GET1^DIQ(.401,SRTTEMP,9,"I"),SCOMPDT=$$FMTMDY^BQIUL1($P($G(SCOMPDT),"."))
  1. ...S BQII=BQII+1
  1. ...D PAD(.TEMPNM,35),PAD(.CREATBY,40),PAD(.FILNM,3)
  1. ...S @DATA@(BQII)=SRTTEMP_U_TEMPNM_FILNM_CREATBY_SCOMPDT_$C(30)
  1. S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1. Q
  1. ;
  1. QMG(DATA,FAKE) ;EP -- BQI GET QMAN TEMPLATE GRID
  1. ; Variables
  1. ; UID - Unique ID for passing data to and from the GUI
  1. ; CLINKEY - IEN for AMQQZCLIN key
  1. ; SRTTEMP - Sort template IEN
  1. ; TEMPUSER - User associated with a template
  1. ; BQII - Increment variable for setting Output nodes
  1. ; FILE - Used to hold the file number for the Patient and Visit files
  1. ; TEMPNM - Template Name
  1. ; CHKTEMP - Used to check if the template has any patients associated with them.
  1. ;
  1. N UID,CLINKEY,SRTTEMP,TEMPUSER,BQII,FILE,TEMPNM,CHKTEMP,USER,CREATBY,SCOMPDT,FILNM
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J),BQII=0,U="^"
  1. S DATA=$NA(^TMP("BQIPLRT1",UID,"QT"))
  1. K @DATA
  1. ;
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERRQT^BQIPLRT1 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1. ;
  1. S @DATA@(BQII)="I00010QMAN_IEN^T00030QMAN_TEMPLATE_NAME^T00001TEMPLATE_TYPE^T00035CREATED_BY^D00015COMPLETED_DATE"_$C(30)
  1. ; If this user does have the AMQQZCLIN security key, create a list of ALL
  1. ; sort templates.
  1. ;
  1. F FILE="F9000001","F9000010" D
  1. .S TEMPNM=""
  1. .F S TEMPNM=$O(^DIBT(FILE,TEMPNM)) Q:TEMPNM="" D
  1. ..S SRTTEMP=0
  1. ..F S SRTTEMP=$O(^DIBT(FILE,TEMPNM,SRTTEMP)) Q:'SRTTEMP D
  1. ...; Check if there are any patients in the template, if not, quit
  1. ...S CHKTEMP=$O(^DIBT(SRTTEMP,1,"")) I 'CHKTEMP Q
  1. ...S USER=$$GET1^DIQ(.401,SRTTEMP,5,"I")
  1. ...S FILNM=$E($$GET1^DIQ(.401,SRTTEMP,4,"E"),1)
  1. ...S CREATBY=$$GET1^DIQ(200,USER,.01,"E")
  1. ...S SCOMPDT=$$GET1^DIQ(.401,SRTTEMP,9,"I"),SCOMPDT=$$FMTMDY^BQIUL1($P($G(SCOMPDT),"."))
  1. ...S BQII=BQII+1
  1. ...S @DATA@(BQII)=SRTTEMP_U_TEMPNM_U_FILNM_U_CREATBY_U_SCOMPDT_$C(30)
  1. S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1. Q
  1. ;
  1. PAD(STRING,FLDLNGTH) ;EP
  1. ; Input
  1. ; STRING - string of data passed by reference
  1. ; FLDLNGTH - Length you want the field to be. For example:
  1. ; if you pass in a string with length of 15, and you need it to be padded
  1. ; out to 30, then you enter 30 as the FLDLNGTH. This will provide for formatting
  1. ; a string.
  1. ;
  1. N SPACE,SPACESTR
  1. F SPACE=$L(STRING):1:FLDLNGTH S SPACESTR=$G(SPACESTR)_" "
  1. S STRING=$G(STRING)_$G(SPACESTR)
  1. Q
  1. ;
  1. ERRQT ; Error trap for Q-Man Template
  1. D ^%ZTER
  1. NEW Y,ERRDTM
  1. S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1. S BMXSEC="Recording that an error occurred at "_ERRDTM
  1. I $D(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1. Q