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

AZAXHRNC.m

Go to the documentation of this file. 
  1. AZAXHRNC ;IHS/PHXAO/AEF - COMPARE PATIENTS IN THE AZAX HRN HISTORICAL LOG FILE
  1.  ;;1.0;ANNE'S SPECIAL ROUTINES;;JULY 13, 2004
  1.  ;
  1.  ;
  1. EN ;EP -- MAIN ENTRY POINT
  1.  ;
  1.  N DFNS
  1.  ;
  1.  D ^XBKVAR
  1.  D HOME^%ZIS
  1.  ;
  1.  D ASK(.DFNS)
  1.  Q:'$O(DFNS(0))
  1.  ;
  1.  D PROC(.DFNS)
  1.  ;
  1.  D CLEANUP
  1.  Q
  1. PROC(DFNS) ;
  1.  ;----- PROCESS THE DATA
  1.  ;
  1.  N COLS
  1.  ;
  1.  D LOOP1(.DFNS,.COLS)
  1.  Q:'$O(^TMP("AZAX",$J,1,0))
  1.  ;
  1.  D PRINT(.COLS)
  1.  ;
  1.  Q
  1. PRINT(COLS) ;
  1.  ;----- PRINT THE DATA
  1.  ;
  1.  N COL,DATA,DFN,EXPDT,FAC,FACS,HRN
  1.  ;
  1.  W @IOF
  1.  ;
  1.  S DFN=0
  1.  F  S DFN=$O(COLS("DFN",DFN)) Q:'DFN  D
  1.  . W "  "_$P($G(^DPT(DFN,0)),U)_" ("_DFN_")"
  1.  . I $O(COLS("DFN",DFN)) W "  VS."
  1.  ;
  1.  W !!
  1.  S DFN=0
  1.  F  S DFN=$O(COLS("DFN",DFN)) Q:'DFN  D
  1.  . S COL=COLS("DFN",DFN)
  1.  . W ?((COL*8)+3),$J(DFN,6,0)
  1.  ;
  1.  W !
  1.  W "EXPDT"
  1.  S DFN=0
  1.  F  S DFN=$O(COLS(DFN)) Q:'DFN  D
  1.  . S FAC=0
  1.  . F  S FAC=$O(COLS(DFN,FAC)) Q:'FAC  D
  1.  . . S COL=COLS(DFN,FAC)
  1.  . . W ?((COL*8)+3),FAC 
  1.  ;
  1.  S EXPDT=0
  1.  F  S EXPDT=$O(^TMP("AZAX",$J,1,EXPDT)) Q:'EXPDT  D
  1.  . W !,$$SLDATE(EXPDT)
  1.  . S DFN=0
  1.  . F  S DFN=$O(^TMP("AZAX",$J,1,EXPDT,DFN)) Q:'DFN  D
  1.  . . S FAC=0
  1.  . . F  S FAC=$O(^TMP("AZAX",$J,1,EXPDT,DFN,FAC)) Q:'FAC  D
  1.  . . . S DATA=$G(^TMP("AZAX",$J,1,EXPDT,DFN,FAC))
  1.  . . . S HRN=$P(DATA,U,3)
  1.  . . . S FACS(FAC)=$P(DATA,U,5)
  1.  . . . S COL=COLS(DFN,FAC)
  1.  . . . W ?((COL*8)+3),$J(HRN,6,0)
  1.  ;
  1.  W !
  1.  S FAC=0
  1.  F  S FAC=$O(FACS(FAC)) Q:'FAC  D
  1.  . W !,FAC_" = "_FACS(FAC)
  1.  Q
  1. LOOP1(DFNS,COLS) ;
  1.  ;----- LOOP THROUGH "C" XREF AND BUILD ^TMP GLOBAL
  1.  ;
  1.  ;      INPUT:  DFN(DFN) ARRAY CONTAINING DFN'S TO COMPARE
  1.  ;
  1.  N CNT,DATA,DFN,IEN
  1.  ;
  1.  K ^TMP("AZAX",$J,1)
  1.  ;
  1.  S CNT=0
  1.  S DFN=0
  1.  F  S DFN=$O(DFNS(DFN)) Q:'DFN  D
  1.  . S IEN=0
  1.  . F  S IEN=$O(^AZAX(1991288,"C",DFN,IEN)) Q:'IEN  D
  1.  . . S DATA=$G(^AZAX(1991288,IEN,0))
  1.  . . Q:'DATA
  1.  . . S ^TMP("AZAX",$J,1,$P(DATA,U,7),$P(DATA,U,2),$P(DATA,U,4))=DATA
  1.  . . D COLS(DATA,.CNT,.COLS)
  1.  Q
  1. COLS(DATA,CNT,COLS) ;
  1.  ;----- FIGURE OUT HOW MANY COLUMNS WE NEED ON THE REPORT
  1.  ;
  1.  N CNT,DFN,FAC
  1.  ;
  1.  S CNT=0
  1.  S DFN=$P(DATA,U,2)
  1.  S FAC=$P(DATA,U,4)
  1.  ;
  1.  S COLS(DFN,FAC)=""
  1.  ;
  1.  S DFN=0
  1.  F  S DFN=$O(COLS(DFN)) Q:'DFN  D
  1.  . S FAC=0 F  S FAC=$O(COLS(DFN,FAC)) Q:'FAC  D
  1.  . . S CNT=$G(CNT)+1
  1.  . . S COLS(DFN,FAC)=CNT
  1.  . . I '$D(COLS("DFN",DFN)) S COLS("DFN",DFN)=CNT
  1.  ;
  1.  S COLS("CNT")=$G(CNT)
  1.  ;
  1.  Q
  1. ASK(DFNS) ;
  1.  ;----- ASK WHICH PATIENTS TO COMPARE AND BUILD DFN(DFN) ARRAY
  1.  ;
  1.  N %1,AGE,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,DFN,DIC,DOB,OUT,SEX,SSN,X,Y
  1.  ;
  1.  S OUT=0
  1.  ;
  1.  S DIC="^DPT("
  1.  S DIC(0)="AEMQI"
  1.  ;
  1.  F  D  Q:OUT
  1.  . D ^DIC
  1.  . I +Y'>0!($D(DUOUT))!($D(DUOUT))!($D(DTOUT)) S OUT=1
  1.  . Q:OUT
  1.  . S DFNS(+Y)=""
  1.  Q
  1. SLDATE(X) ;
  1.  ;----- RETURNS DATE IN MM/DD/YY FORMAT
  1.  ;
  1.  N Y
  1.  S Y=""
  1.  I X D
  1.  . S Y=$P(X,".")
  1.  . Q:'Y
  1.  . S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
  1.  Q Y
  1. CLEANUP ;
  1.  ;----- HOUSEKEEPING
  1.  ;
  1.  K ^TMP("AZAX",$J,1)
  1.  Q