MHVXTIU ;KUM - ITEMS of Document Class extract ; [01/26/13 11:38am]
;;1.0;My HealtheVet;**10**;Jan 26, 2013;Build 50
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; Integration Agreements:
;
; 10004 : $$GET1^DIQ
; 4094 : ^TIU(8925.1
;
Q
;
; Retrieves requested Titles data and returns it in DATAROOT
; Retrieves all Titles of Document class of active statuses
;
;
; Input:
; QRY - Query array
; QRY(DCLSNM) - (required) Document Class Name
; DATAROOT - Root of array to hold extract data
;
; Output:
; DATAROOT - Populated data array, includes # of hits
; ERR - Errors during extraction
;
N HIT,DFN,MHVDCIEN,MHVDCNM,MHVDCITM
;
D LOG^MHVUL2("MHVXRX EXTRACT","BEGIN","S","TRACE")
S ERR=0,HIT=0
K @DATAROOT
S MHVDCNM=$G(QRY("DCLSNM"))
;
; Extract IEN of Document Class from TIU Document Definition File (#8925.1)
S MHVDCIEN=$$DOCDEF(MHVDCNM)
I 'MHVDCIEN S ERR="1^Documnet Class "_MHVDCNM_" of status Active is not found." Q
;
I MHVDCIEN D ITEMS(MHVDCIEN)
;
S @DATAROOT=HIT
D LOG^MHVUL2("MHVXPRG EXTRACT",HIT_" HITS","S","TRACE")
D LOG^MHVUL2("MHVXPRG EXTRACT","END","S","TRACE")
Q
;
DOCDEF(MHVDCNM) ;Look up IEN of DOCUMENT CLASS NAME if it is active
N MHVDC,MHVPPCW
S MHVDC=0 F S MHVDC=$O(^TIU(8925.1,"B",MHVDCNM,MHVDC)) Q:+MHVDC'>0!+$G(MHVPPCW) D
. I (($$GET1^DIQ(8925.1,+MHVDC,.04,"I")="DC")&($$GET1^DIQ(8925.1,+MHVDC,.07,"E")="ACTIVE")) S MHVDCIEN=+MHVDC
S:'$D(MHVDCIEN) MHVDCIEN=0
Q MHVDCIEN
;
ITEMS(MHVDCIEN) ; Sets items of MHVDCIEN into array MHVDCITM in proper order.
; MHVDCITM(TIUFI)=Item's 8925.1 IFN^Item's IFN in Item multiple
; Requires MHVDCIEN = Entry's 8925.1 IFN
N TIUFI,SEQ,TENDA,TENODE0,NAME,MHVDCTIM,MHVTIEN,MHVTNAM,MHVTPNAM,MHVTSEQ,MHVTSTS,MHVTTYP
S HIT=0
S (TIUFI,SEQ,TENDA)=0
F S SEQ=$O(^TIU(8925.1,MHVDCIEN,10,"AC",SEQ)) Q:'SEQ D
. ; Set items having sequence into MHVDCITM in sequence order
. F S TENDA=$O(^TIU(8925.1,MHVDCIEN,10,"AC",SEQ,TENDA)) Q:'TENDA D
. . S TENODE0=^TIU(8925.1,MHVDCIEN,10,TENDA,0) Q:'TENODE0
. . S TIUFI=TIUFI+1,MHVDCTIM(TIUFI)=+TENODE0_"^"_TENDA
S NAME=""
F S NAME=$O(^TIU(8925.1,MHVDCIEN,10,"C",NAME)) Q:NAME="" D
. ; Set items with no sequence into MHVDCITM in alpha order by Display Name.
. S TENDA=0
. F S TENDA=$O(^TIU(8925.1,MHVDCIEN,10,"C",NAME,TENDA)) Q:'TENDA D
. . S TENODE0=^TIU(8925.1,MHVDCIEN,10,TENDA,0) Q:'TENODE0
. . Q:$P(TENODE0,U,3) ;If has sequence, already in MHVDCITM.
. . S TIUFI=TIUFI+1,MHVDCTIM(TIUFI)=+TENODE0_"^"_TENDA
S TENDA=0
F S TENDA=$O(^TIU(8925.1,MHVDCIEN,10,TENDA)) Q:'TENDA D
. ; Set items with no sequence, no display name into buffer in item order
. S TENODE0=^TIU(8925.1,MHVDCIEN,10,TENDA,0) Q:'TENODE0
. Q:$P(TENODE0,U,3) ;If has sequence, already in MHVDCITM.
. Q:$P(TENODE0,U,4)'="" ;If has Display Name, already in MHVDCITM.
. S TIUFI=TIUFI+1,MHVDCTIM(TIUFI)=+TENODE0_"^"_TENDA
S TENDA=0
F S TENDA=$O(MHVDCTIM(TENDA)) Q:'TENDA D
. ; Retrieve other required fields
. S MHVTIEN=+($P(MHVDCTIM(TENDA),U,1))
. S MHVTNAM=$$GET1^DIQ(8925.1,+MHVTIEN,.01,"I")
. S MHVTPNAM=$$GET1^DIQ(8925.1,+MHVTIEN,.03,"I")
. S MHVTTYP=$$GET1^DIQ(8925.1,+MHVTIEN,.04,"I")
. S MHVTSTS=$$GET1^DIQ(8925.1,+MHVTIEN,.07,"E")
. I ((MHVTTYP="DOC")&(MHVTSTS="ACTIVE")) D
. . S HIT=HIT+1
. . S MHVTSEQ=$P(^TIU(8925.1,MHVDCIEN,10,$P(MHVDCTIM(TENDA),"^",2),0),"^",3)
. . S @DATAROOT@(HIT)=MHVTIEN_U_MHVTSEQ_U_MHVTNAM_U_MHVTPNAM
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHVXTIU 3625 printed Dec 13, 2024@02:16:20 Page 2
MHVXTIU ;KUM - ITEMS of Document Class extract ; [01/26/13 11:38am]
+1 ;;1.0;My HealtheVet;**10**;Jan 26, 2013;Build 50
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; Integration Agreements:
+5 ;
+6 ; 10004 : $$GET1^DIQ
+7 ; 4094 : ^TIU(8925.1
+8 ;
+9 QUIT
+10 ;
+1 ; Retrieves requested Titles data and returns it in DATAROOT
+2 ; Retrieves all Titles of Document class of active statuses
+3 ;
+4 ;
+5 ; Input:
+6 ; QRY - Query array
+7 ; QRY(DCLSNM) - (required) Document Class Name
+8 ; DATAROOT - Root of array to hold extract data
+9 ;
+10 ; Output:
+11 ; DATAROOT - Populated data array, includes # of hits
+12 ; ERR - Errors during extraction
+13 ;
+14 NEW HIT,DFN,MHVDCIEN,MHVDCNM,MHVDCITM
+15 ;
+16 DO LOG^MHVUL2("MHVXRX EXTRACT","BEGIN","S","TRACE")
+17 SET ERR=0
SET HIT=0
+18 KILL @DATAROOT
+19 SET MHVDCNM=$GET(QRY("DCLSNM"))
+20 ;
+21 ; Extract IEN of Document Class from TIU Document Definition File (#8925.1)
+22 SET MHVDCIEN=$$DOCDEF(MHVDCNM)
+23 IF 'MHVDCIEN
SET ERR="1^Documnet Class "_MHVDCNM_" of status Active is not found."
QUIT
+24 ;
+25 IF MHVDCIEN
DO ITEMS(MHVDCIEN)
+26 ;
+27 SET @DATAROOT=HIT
+28 DO LOG^MHVUL2("MHVXPRG EXTRACT",HIT_" HITS","S","TRACE")
+29 DO LOG^MHVUL2("MHVXPRG EXTRACT","END","S","TRACE")
+30 QUIT
+31 ;
DOCDEF(MHVDCNM) ;Look up IEN of DOCUMENT CLASS NAME if it is active
+1 NEW MHVDC,MHVPPCW
+2 SET MHVDC=0
FOR
SET MHVDC=$ORDER(^TIU(8925.1,"B",MHVDCNM,MHVDC))
if +MHVDC'>0!+$GET(MHVPPCW)
QUIT
Begin DoDot:1
+3 IF (($$GET1^DIQ(8925.1,+MHVDC,.04,"I")="DC")&($$GET1^DIQ(8925.1,+MHVDC,.07,"E")="ACTIVE"))
SET MHVDCIEN=+MHVDC
End DoDot:1
+4 if '$DATA(MHVDCIEN)
SET MHVDCIEN=0
+5 QUIT MHVDCIEN
+6 ;
ITEMS(MHVDCIEN) ; Sets items of MHVDCIEN into array MHVDCITM in proper order.
+1 ; MHVDCITM(TIUFI)=Item's 8925.1 IFN^Item's IFN in Item multiple
+2 ; Requires MHVDCIEN = Entry's 8925.1 IFN
+3 NEW TIUFI,SEQ,TENDA,TENODE0,NAME,MHVDCTIM,MHVTIEN,MHVTNAM,MHVTPNAM,MHVTSEQ,MHVTSTS,MHVTTYP
+4 SET HIT=0
+5 SET (TIUFI,SEQ,TENDA)=0
+6 FOR
SET SEQ=$ORDER(^TIU(8925.1,MHVDCIEN,10,"AC",SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+7 ; Set items having sequence into MHVDCITM in sequence order
+8 FOR
SET TENDA=$ORDER(^TIU(8925.1,MHVDCIEN,10,"AC",SEQ,TENDA))
if 'TENDA
QUIT
Begin DoDot:2
+9 SET TENODE0=^TIU(8925.1,MHVDCIEN,10,TENDA,0)
if 'TENODE0
QUIT
+10 SET TIUFI=TIUFI+1
SET MHVDCTIM(TIUFI)=+TENODE0_"^"_TENDA
End DoDot:2
End DoDot:1
+11 SET NAME=""
+12 FOR
SET NAME=$ORDER(^TIU(8925.1,MHVDCIEN,10,"C",NAME))
if NAME=""
QUIT
Begin DoDot:1
+13 ; Set items with no sequence into MHVDCITM in alpha order by Display Name.
+14 SET TENDA=0
+15 FOR
SET TENDA=$ORDER(^TIU(8925.1,MHVDCIEN,10,"C",NAME,TENDA))
if 'TENDA
QUIT
Begin DoDot:2
+16 SET TENODE0=^TIU(8925.1,MHVDCIEN,10,TENDA,0)
if 'TENODE0
QUIT
+17 ;If has sequence, already in MHVDCITM.
if $PIECE(TENODE0,U,3)
QUIT
+18 SET TIUFI=TIUFI+1
SET MHVDCTIM(TIUFI)=+TENODE0_"^"_TENDA
End DoDot:2
End DoDot:1
+19 SET TENDA=0
+20 FOR
SET TENDA=$ORDER(^TIU(8925.1,MHVDCIEN,10,TENDA))
if 'TENDA
QUIT
Begin DoDot:1
+21 ; Set items with no sequence, no display name into buffer in item order
+22 SET TENODE0=^TIU(8925.1,MHVDCIEN,10,TENDA,0)
if 'TENODE0
QUIT
+23 ;If has sequence, already in MHVDCITM.
if $PIECE(TENODE0,U,3)
QUIT
+24 ;If has Display Name, already in MHVDCITM.
if $PIECE(TENODE0,U,4)'=""
QUIT
+25 SET TIUFI=TIUFI+1
SET MHVDCTIM(TIUFI)=+TENODE0_"^"_TENDA
End DoDot:1
+26 SET TENDA=0
+27 FOR
SET TENDA=$ORDER(MHVDCTIM(TENDA))
if 'TENDA
QUIT
Begin DoDot:1
+28 ; Retrieve other required fields
+29 SET MHVTIEN=+($PIECE(MHVDCTIM(TENDA),U,1))
+30 SET MHVTNAM=$$GET1^DIQ(8925.1,+MHVTIEN,.01,"I")
+31 SET MHVTPNAM=$$GET1^DIQ(8925.1,+MHVTIEN,.03,"I")
+32 SET MHVTTYP=$$GET1^DIQ(8925.1,+MHVTIEN,.04,"I")
+33 SET MHVTSTS=$$GET1^DIQ(8925.1,+MHVTIEN,.07,"E")
+34 IF ((MHVTTYP="DOC")&(MHVTSTS="ACTIVE"))
Begin DoDot:2
+35 SET HIT=HIT+1
+36 SET MHVTSEQ=$PIECE(^TIU(8925.1,MHVDCIEN,10,$PIECE(MHVDCTIM(TENDA),"^",2),0),"^",3)
+37 SET @DATAROOT@(HIT)=MHVTIEN_U_MHVTSEQ_U_MHVTNAM_U_MHVTPNAM
End DoDot:2
End DoDot:1
+38 QUIT
+39 ;
