BKMQUTL ;PRXM/HC/BWF - BKM Report Utilities; [ 1/19/2005 7:16 PM ] ; 13 Jun 2005 3:41 PM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
; Designed to write to a temporary file for iCare
;
CTR(TEXT) ; EP - Center data.
;
; Input - TEXT - Text (required)
; LENGTH - Line length (default is 80)
; This utility will center the data before filing it to the RPC temporary global.
;
N CENTER,CLINE,LEN,START
S LEN=$L(TEXT)
S CENTER=LEN/2,CLINE=LNLEN/2
S START=CLINE-CENTER\1
S TEXT=$$LINE("",TEXT,START)
D UPD(TEXT)
Q
;
LINE(TEXT,STR,POS) ; Set text to match printed report formatting
I $L(TEXT)>POS Q TEXT_STR
S $E(TEXT,POS)=STR
Q TEXT
;
UPD(LINE,NUM,SUPP) ;EP
; Update global with line of text
; NUM - Number of blank lines that follow text
; SUPP - Suppress line feed carriage return
S NUM=$G(NUM),SUPP=$G(SUPP)
S BQII=BQII+1,@DATA@(BQII)=LINE_$S(SUPP:"",1:$C(13)_$C(10))
I NUM D
. N II
. F II=1:1:NUM S BQII=BQII+1,@DATA@(BQII)=$C(13)_$C(10)
Q
;
COLHDR ;
S @DATA@(BQII)="T00120REPORT_TEXT"_$C(30)
Q
HMSDEN(HMSIEN,DFN) ; EP -- Is patient in HMS denominator?
;
; Input:
; HMSIEN - internal entry number of HMS tag in file #90506.2
; DFN - the patient's DFN
;
; Output:
; 0 - patient is not in the denominator
; 1 - patient is in the denominator
;
; Denominator:
; Patients with Proposed or Accepted tag status
; with an HMS register status of active or blank (not in register)
;
; Check Tag status
N TAGIEN,TAGSTAT,STAT,REG,REGIEN,IENS
S TAGIEN=$O(^BQIREG("C",DFN,HMSIEN,""))
I TAGIEN="" Q 0 ; No HMS tag
S TAGSTAT=$$GET1^DIQ(90509,TAGIEN_",",.03,"I")
I TAGSTAT'="A",TAGSTAT'="P" Q 0
;
; Check HMS Register status
S IENS=$$HMSIENS(DFN),STAT=""
I IENS'="" S STAT=$$GET1^DIQ(90451.01,IENS,.5,"I")
I "A"'[STAT Q 0 ; Only 'A'ctive or blank
Q 1
;
HMSIENS(DFN) ; Retrieve HMS Register IENS for specified patient
S REG="HIV Management System",REGIEN=$O(^BQI(90507,"B",REG,""))
S EXEC=$$GET1^DIQ(90507,REGIEN_",",3,"I")
X EXEC ; Sets IENS for patient's HMS data
Q IENS
;
ACT(DFN,DXCAT,STAT) ;EP - Check for Dx tag status for a patient
; DFN - Patient ien
; DXCAT - ien of diagnostic category
; STAT - desired status; if blank either A or P
;
NEW ACT,RIEN,CSTAT
S RIEN="",ACT=0,CSTAT=""
F S RIEN=$O(^BQIREG("C",DFN,DXCAT,RIEN)) Q:RIEN="" D
. S CSTAT=$P(^BQIREG(RIEN,0),U,3)
. I $G(STAT)="B",CSTAT="A"!(CSTAT="P") S ACT=1
. I $G(STAT)'="B",STAT=CSTAT S ACT=1
Q ACT_U_CSTAT
BKMQUTL ;PRXM/HC/BWF - BKM Report Utilities; [ 1/19/2005 7:16 PM ] ; 13 Jun 2005 3:41 PM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ; Designed to write to a temporary file for iCare
+3 ;
CTR(TEXT) ; EP - Center data.
+1 ;
+2 ; Input - TEXT - Text (required)
+3 ; LENGTH - Line length (default is 80)
+4 ; This utility will center the data before filing it to the RPC temporary global.
+5 ;
+6 NEW CENTER,CLINE,LEN,START
+7 SET LEN=$LENGTH(TEXT)
+8 SET CENTER=LEN/2
SET CLINE=LNLEN/2
+9 SET START=CLINE-CENTER\1
+10 SET TEXT=$$LINE("",TEXT,START)
+11 DO UPD(TEXT)
+12 QUIT
+13 ;
LINE(TEXT,STR,POS) ; Set text to match printed report formatting
+1 IF $LENGTH(TEXT)>POS
QUIT TEXT_STR
+2 SET $EXTRACT(TEXT,POS)=STR
+3 QUIT TEXT
+4 ;
UPD(LINE,NUM,SUPP) ;EP
+1 ; Update global with line of text
+2 ; NUM - Number of blank lines that follow text
+3 ; SUPP - Suppress line feed carriage return
+4 SET NUM=$GET(NUM)
SET SUPP=$GET(SUPP)
+5 SET BQII=BQII+1
SET @DATA@(BQII)=LINE_$SELECT(SUPP:"",1:$CHAR(13)_$CHAR(10))
+6 IF NUM
Begin DoDot:1
+7 NEW II
+8 FOR II=1:1:NUM
SET BQII=BQII+1
SET @DATA@(BQII)=$CHAR(13)_$CHAR(10)
End DoDot:1
+9 QUIT
+10 ;
COLHDR ;
+1 SET @DATA@(BQII)="T00120REPORT_TEXT"_$CHAR(30)
+2 QUIT
HMSDEN(HMSIEN,DFN) ; EP -- Is patient in HMS denominator?
+1 ;
+2 ; Input:
+3 ; HMSIEN - internal entry number of HMS tag in file #90506.2
+4 ; DFN - the patient's DFN
+5 ;
+6 ; Output:
+7 ; 0 - patient is not in the denominator
+8 ; 1 - patient is in the denominator
+9 ;
+10 ; Denominator:
+11 ; Patients with Proposed or Accepted tag status
+12 ; with an HMS register status of active or blank (not in register)
+13 ;
+14 ; Check Tag status
+15 NEW TAGIEN,TAGSTAT,STAT,REG,REGIEN,IENS
+16 SET TAGIEN=$ORDER(^BQIREG("C",DFN,HMSIEN,""))
+17 ; No HMS tag
IF TAGIEN=""
QUIT 0
+18 SET TAGSTAT=$$GET1^DIQ(90509,TAGIEN_",",.03,"I")
+19 IF TAGSTAT'="A"
IF TAGSTAT'="P"
QUIT 0
+20 ;
+21 ; Check HMS Register status
+22 SET IENS=$$HMSIENS(DFN)
SET STAT=""
+23 IF IENS'=""
SET STAT=$$GET1^DIQ(90451.01,IENS,.5,"I")
+24 ; Only 'A'ctive or blank
IF "A"'[STAT
QUIT 0
+25 QUIT 1
+26 ;
HMSIENS(DFN) ; Retrieve HMS Register IENS for specified patient
+1 SET REG="HIV Management System"
SET REGIEN=$ORDER(^BQI(90507,"B",REG,""))
+2 SET EXEC=$$GET1^DIQ(90507,REGIEN_",",3,"I")
+3 ; Sets IENS for patient's HMS data
XECUTE EXEC
+4 QUIT IENS
+5 ;
ACT(DFN,DXCAT,STAT) ;EP - Check for Dx tag status for a patient
+1 ; DFN - Patient ien
+2 ; DXCAT - ien of diagnostic category
+3 ; STAT - desired status; if blank either A or P
+4 ;
+5 NEW ACT,RIEN,CSTAT
+6 SET RIEN=""
SET ACT=0
SET CSTAT=""
+7 FOR
SET RIEN=$ORDER(^BQIREG("C",DFN,DXCAT,RIEN))
IF RIEN=""
QUIT
Begin DoDot:1
+8 SET CSTAT=$PIECE(^BQIREG(RIEN,0),U,3)
+9 IF $GET(STAT)="B"
IF CSTAT="A"!(CSTAT="P")
SET ACT=1
+10 IF $GET(STAT)'="B"
IF STAT=CSTAT
SET ACT=1
End DoDot:1
+11 QUIT ACT_U_CSTAT
