Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MHVXTIU

MHVXTIU.m

Go to the documentation of this file.
  1. MHVXTIU ;KUM - ITEMS of Document Class extract ; [01/26/13 11:38am]
  1. ;;1.0;My HealtheVet;**10**;Jan 26, 2013;Build 50
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; Integration Agreements:
  1. ;
  1. ; 10004 : $$GET1^DIQ
  1. ; 4094 : ^TIU(8925.1
  1. ;
  1. Q
  1. ;
  1. EXTRACT(QRY,ERR,DATAROOT) ; Entry point to extract Titles data
  1. ; Retrieves requested Titles data and returns it in DATAROOT
  1. ; Retrieves all Titles of Document class of active statuses
  1. ;
  1. ;
  1. ; Input:
  1. ; QRY - Query array
  1. ; QRY(DCLSNM) - (required) Document Class Name
  1. ; DATAROOT - Root of array to hold extract data
  1. ;
  1. ; Output:
  1. ; DATAROOT - Populated data array, includes # of hits
  1. ; ERR - Errors during extraction
  1. ;
  1. N HIT,DFN,MHVDCIEN,MHVDCNM,MHVDCITM
  1. ;
  1. D LOG^MHVUL2("MHVXRX EXTRACT","BEGIN","S","TRACE")
  1. S ERR=0,HIT=0
  1. K @DATAROOT
  1. S MHVDCNM=$G(QRY("DCLSNM"))
  1. ;
  1. ; Extract IEN of Document Class from TIU Document Definition File (#8925.1)
  1. S MHVDCIEN=$$DOCDEF(MHVDCNM)
  1. I 'MHVDCIEN S ERR="1^Documnet Class "_MHVDCNM_" of status Active is not found." Q
  1. ;
  1. I MHVDCIEN D ITEMS(MHVDCIEN)
  1. ;
  1. S @DATAROOT=HIT
  1. D LOG^MHVUL2("MHVXPRG EXTRACT",HIT_" HITS","S","TRACE")
  1. D LOG^MHVUL2("MHVXPRG EXTRACT","END","S","TRACE")
  1. Q
  1. ;
  1. DOCDEF(MHVDCNM) ;Look up IEN of DOCUMENT CLASS NAME if it is active
  1. N MHVDC,MHVPPCW
  1. S MHVDC=0 F S MHVDC=$O(^TIU(8925.1,"B",MHVDCNM,MHVDC)) Q:+MHVDC'>0!+$G(MHVPPCW) D
  1. . I (($$GET1^DIQ(8925.1,+MHVDC,.04,"I")="DC")&($$GET1^DIQ(8925.1,+MHVDC,.07,"E")="ACTIVE")) S MHVDCIEN=+MHVDC
  1. S:'$D(MHVDCIEN) MHVDCIEN=0
  1. Q MHVDCIEN
  1. ;
  1. 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
  1. ; Requires MHVDCIEN = Entry's 8925.1 IFN
  1. N TIUFI,SEQ,TENDA,TENODE0,NAME,MHVDCTIM,MHVTIEN,MHVTNAM,MHVTPNAM,MHVTSEQ,MHVTSTS,MHVTTYP
  1. S HIT=0
  1. S (TIUFI,SEQ,TENDA)=0
  1. F S SEQ=$O(^TIU(8925.1,MHVDCIEN,10,"AC",SEQ)) Q:'SEQ D
  1. . ; Set items having sequence into MHVDCITM in sequence order
  1. . F S TENDA=$O(^TIU(8925.1,MHVDCIEN,10,"AC",SEQ,TENDA)) Q:'TENDA D
  1. . . S TENODE0=^TIU(8925.1,MHVDCIEN,10,TENDA,0) Q:'TENODE0
  1. . . S TIUFI=TIUFI+1,MHVDCTIM(TIUFI)=+TENODE0_"^"_TENDA
  1. S NAME=""
  1. F S NAME=$O(^TIU(8925.1,MHVDCIEN,10,"C",NAME)) Q:NAME="" D
  1. . ; Set items with no sequence into MHVDCITM in alpha order by Display Name.
  1. . S TENDA=0
  1. . F S TENDA=$O(^TIU(8925.1,MHVDCIEN,10,"C",NAME,TENDA)) Q:'TENDA D
  1. . . S TENODE0=^TIU(8925.1,MHVDCIEN,10,TENDA,0) Q:'TENODE0
  1. . . Q:$P(TENODE0,U,3) ;If has sequence, already in MHVDCITM.
  1. . . S TIUFI=TIUFI+1,MHVDCTIM(TIUFI)=+TENODE0_"^"_TENDA
  1. S TENDA=0
  1. F S TENDA=$O(^TIU(8925.1,MHVDCIEN,10,TENDA)) Q:'TENDA D
  1. . ; Set items with no sequence, no display name into buffer in item order
  1. . S TENODE0=^TIU(8925.1,MHVDCIEN,10,TENDA,0) Q:'TENODE0
  1. . Q:$P(TENODE0,U,3) ;If has sequence, already in MHVDCITM.
  1. . Q:$P(TENODE0,U,4)'="" ;If has Display Name, already in MHVDCITM.
  1. . S TIUFI=TIUFI+1,MHVDCTIM(TIUFI)=+TENODE0_"^"_TENDA
  1. S TENDA=0
  1. F S TENDA=$O(MHVDCTIM(TENDA)) Q:'TENDA D
  1. . ; Retrieve other required fields
  1. . S MHVTIEN=+($P(MHVDCTIM(TENDA),U,1))
  1. . S MHVTNAM=$$GET1^DIQ(8925.1,+MHVTIEN,.01,"I")
  1. . S MHVTPNAM=$$GET1^DIQ(8925.1,+MHVTIEN,.03,"I")
  1. . S MHVTTYP=$$GET1^DIQ(8925.1,+MHVTIEN,.04,"I")
  1. . S MHVTSTS=$$GET1^DIQ(8925.1,+MHVTIEN,.07,"E")
  1. . I ((MHVTTYP="DOC")&(MHVTSTS="ACTIVE")) D
  1. . . S HIT=HIT+1
  1. . . S MHVTSEQ=$P(^TIU(8925.1,MHVDCIEN,10,$P(MHVDCTIM(TENDA),"^",2),0),"^",3)
  1. . . S @DATAROOT@(HIT)=MHVTIEN_U_MHVTSEQ_U_MHVTNAM_U_MHVTPNAM
  1. Q
  1. ;