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
