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