- 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 Jan 18, 2025@03:17:22 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 ;