AZAXHRNC ;IHS/PHXAO/AEF - COMPARE PATIENTS IN THE AZAX HRN HISTORICAL LOG FILE
;;1.0;ANNE'S SPECIAL ROUTINES;;JULY 13, 2004
;
;
EN ;EP -- MAIN ENTRY POINT
;
N DFNS
;
D ^XBKVAR
D HOME^%ZIS
;
D ASK(.DFNS)
Q:'$O(DFNS(0))
;
D PROC(.DFNS)
;
D CLEANUP
Q
PROC(DFNS) ;
;----- PROCESS THE DATA
;
N COLS
;
D LOOP1(.DFNS,.COLS)
Q:'$O(^TMP("AZAX",$J,1,0))
;
D PRINT(.COLS)
;
Q
PRINT(COLS) ;
;----- PRINT THE DATA
;
N COL,DATA,DFN,EXPDT,FAC,FACS,HRN
;
W @IOF
;
S DFN=0
F S DFN=$O(COLS("DFN",DFN)) Q:'DFN D
. W " "_$P($G(^DPT(DFN,0)),U)_" ("_DFN_")"
. I $O(COLS("DFN",DFN)) W " VS."
;
W !!
S DFN=0
F S DFN=$O(COLS("DFN",DFN)) Q:'DFN D
. S COL=COLS("DFN",DFN)
. W ?((COL*8)+3),$J(DFN,6,0)
;
W !
W "EXPDT"
S DFN=0
F S DFN=$O(COLS(DFN)) Q:'DFN D
. S FAC=0
. F S FAC=$O(COLS(DFN,FAC)) Q:'FAC D
. . S COL=COLS(DFN,FAC)
. . W ?((COL*8)+3),FAC
;
S EXPDT=0
F S EXPDT=$O(^TMP("AZAX",$J,1,EXPDT)) Q:'EXPDT D
. W !,$$SLDATE(EXPDT)
. S DFN=0
. F S DFN=$O(^TMP("AZAX",$J,1,EXPDT,DFN)) Q:'DFN D
. . S FAC=0
. . F S FAC=$O(^TMP("AZAX",$J,1,EXPDT,DFN,FAC)) Q:'FAC D
. . . S DATA=$G(^TMP("AZAX",$J,1,EXPDT,DFN,FAC))
. . . S HRN=$P(DATA,U,3)
. . . S FACS(FAC)=$P(DATA,U,5)
. . . S COL=COLS(DFN,FAC)
. . . W ?((COL*8)+3),$J(HRN,6,0)
;
W !
S FAC=0
F S FAC=$O(FACS(FAC)) Q:'FAC D
. W !,FAC_" = "_FACS(FAC)
Q
LOOP1(DFNS,COLS) ;
;----- LOOP THROUGH "C" XREF AND BUILD ^TMP GLOBAL
;
; INPUT: DFN(DFN) ARRAY CONTAINING DFN'S TO COMPARE
;
N CNT,DATA,DFN,IEN
;
K ^TMP("AZAX",$J,1)
;
S CNT=0
S DFN=0
F S DFN=$O(DFNS(DFN)) Q:'DFN D
. S IEN=0
. F S IEN=$O(^AZAX(1991288,"C",DFN,IEN)) Q:'IEN D
. . S DATA=$G(^AZAX(1991288,IEN,0))
. . Q:'DATA
. . S ^TMP("AZAX",$J,1,$P(DATA,U,7),$P(DATA,U,2),$P(DATA,U,4))=DATA
. . D COLS(DATA,.CNT,.COLS)
Q
COLS(DATA,CNT,COLS) ;
;----- FIGURE OUT HOW MANY COLUMNS WE NEED ON THE REPORT
;
N CNT,DFN,FAC
;
S CNT=0
S DFN=$P(DATA,U,2)
S FAC=$P(DATA,U,4)
;
S COLS(DFN,FAC)=""
;
S DFN=0
F S DFN=$O(COLS(DFN)) Q:'DFN D
. S FAC=0 F S FAC=$O(COLS(DFN,FAC)) Q:'FAC D
. . S CNT=$G(CNT)+1
. . S COLS(DFN,FAC)=CNT
. . I '$D(COLS("DFN",DFN)) S COLS("DFN",DFN)=CNT
;
S COLS("CNT")=$G(CNT)
;
Q
ASK(DFNS) ;
;----- ASK WHICH PATIENTS TO COMPARE AND BUILD DFN(DFN) ARRAY
;
N %1,AGE,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,DFN,DIC,DOB,OUT,SEX,SSN,X,Y
;
S OUT=0
;
S DIC="^DPT("
S DIC(0)="AEMQI"
;
F D Q:OUT
. D ^DIC
. I +Y'>0!($D(DUOUT))!($D(DUOUT))!($D(DTOUT)) S OUT=1
. Q:OUT
. S DFNS(+Y)=""
Q
SLDATE(X) ;
;----- RETURNS DATE IN MM/DD/YY FORMAT
;
N Y
S Y=""
I X D
. S Y=$P(X,".")
. Q:'Y
. S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
Q Y
CLEANUP ;
;----- HOUSEKEEPING
;
K ^TMP("AZAX",$J,1)
Q
AZAXHRNC ;IHS/PHXAO/AEF - COMPARE PATIENTS IN THE AZAX HRN HISTORICAL LOG FILE
+1 ;;1.0;ANNE'S SPECIAL ROUTINES;;JULY 13, 2004
+2 ;
+3 ;
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 NEW DFNS
+3 ;
+4 DO ^XBKVAR
+5 DO HOME^%ZIS
+6 ;
+7 DO ASK(.DFNS)
+8 IF '$ORDER(DFNS(0))
QUIT
+9 ;
+10 DO PROC(.DFNS)
+11 ;
+12 DO CLEANUP
+13 QUIT
PROC(DFNS) ;
+1 ;----- PROCESS THE DATA
+2 ;
+3 NEW COLS
+4 ;
+5 DO LOOP1(.DFNS,.COLS)
+6 IF '$ORDER(^TMP("AZAX",$JOB,1,0))
QUIT
+7 ;
+8 DO PRINT(.COLS)
+9 ;
+10 QUIT
PRINT(COLS) ;
+1 ;----- PRINT THE DATA
+2 ;
+3 NEW COL,DATA,DFN,EXPDT,FAC,FACS,HRN
+4 ;
+5 WRITE @IOF
+6 ;
+7 SET DFN=0
+8 FOR
SET DFN=$ORDER(COLS("DFN",DFN))
IF 'DFN
QUIT
Begin DoDot:1
+9 WRITE " "_$PIECE($GET(^DPT(DFN,0)),U)_" ("_DFN_")"
+10 IF $ORDER(COLS("DFN",DFN))
WRITE " VS."
End DoDot:1
+11 ;
+12 WRITE !!
+13 SET DFN=0
+14 FOR
SET DFN=$ORDER(COLS("DFN",DFN))
IF 'DFN
QUIT
Begin DoDot:1
+15 SET COL=COLS("DFN",DFN)
+16 WRITE ?((COL*8)+3),$JUSTIFY(DFN,6,0)
End DoDot:1
+17 ;
+18 WRITE !
+19 WRITE "EXPDT"
+20 SET DFN=0
+21 FOR
SET DFN=$ORDER(COLS(DFN))
IF 'DFN
QUIT
Begin DoDot:1
+22 SET FAC=0
+23 FOR
SET FAC=$ORDER(COLS(DFN,FAC))
IF 'FAC
QUIT
Begin DoDot:2
+24 SET COL=COLS(DFN,FAC)
+25 WRITE ?((COL*8)+3),FAC
End DoDot:2
End DoDot:1
+26 ;
+27 SET EXPDT=0
+28 FOR
SET EXPDT=$ORDER(^TMP("AZAX",$JOB,1,EXPDT))
IF 'EXPDT
QUIT
Begin DoDot:1
+29 WRITE !,$$SLDATE(EXPDT)
+30 SET DFN=0
+31 FOR
SET DFN=$ORDER(^TMP("AZAX",$JOB,1,EXPDT,DFN))
IF 'DFN
QUIT
Begin DoDot:2
+32 SET FAC=0
+33 FOR
SET FAC=$ORDER(^TMP("AZAX",$JOB,1,EXPDT,DFN,FAC))
IF 'FAC
QUIT
Begin DoDot:3
+34 SET DATA=$GET(^TMP("AZAX",$JOB,1,EXPDT,DFN,FAC))
+35 SET HRN=$PIECE(DATA,U,3)
+36 SET FACS(FAC)=$PIECE(DATA,U,5)
+37 SET COL=COLS(DFN,FAC)
+38 WRITE ?((COL*8)+3),$JUSTIFY(HRN,6,0)
End DoDot:3
End DoDot:2
End DoDot:1
+39 ;
+40 WRITE !
+41 SET FAC=0
+42 FOR
SET FAC=$ORDER(FACS(FAC))
IF 'FAC
QUIT
Begin DoDot:1
+43 WRITE !,FAC_" = "_FACS(FAC)
End DoDot:1
+44 QUIT
LOOP1(DFNS,COLS) ;
+1 ;----- LOOP THROUGH "C" XREF AND BUILD ^TMP GLOBAL
+2 ;
+3 ; INPUT: DFN(DFN) ARRAY CONTAINING DFN'S TO COMPARE
+4 ;
+5 NEW CNT,DATA,DFN,IEN
+6 ;
+7 KILL ^TMP("AZAX",$JOB,1)
+8 ;
+9 SET CNT=0
+10 SET DFN=0
+11 FOR
SET DFN=$ORDER(DFNS(DFN))
IF 'DFN
QUIT
Begin DoDot:1
+12 SET IEN=0
+13 FOR
SET IEN=$ORDER(^AZAX(1991288,"C",DFN,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+14 SET DATA=$GET(^AZAX(1991288,IEN,0))
+15 IF 'DATA
QUIT
+16 SET ^TMP("AZAX",$JOB,1,$PIECE(DATA,U,7),$PIECE(DATA,U,2),$PIECE(DATA,U,4))=DATA
+17 DO COLS(DATA,.CNT,.COLS)
End DoDot:2
End DoDot:1
+18 QUIT
COLS(DATA,CNT,COLS) ;
+1 ;----- FIGURE OUT HOW MANY COLUMNS WE NEED ON THE REPORT
+2 ;
+3 NEW CNT,DFN,FAC
+4 ;
+5 SET CNT=0
+6 SET DFN=$PIECE(DATA,U,2)
+7 SET FAC=$PIECE(DATA,U,4)
+8 ;
+9 SET COLS(DFN,FAC)=""
+10 ;
+11 SET DFN=0
+12 FOR
SET DFN=$ORDER(COLS(DFN))
IF 'DFN
QUIT
Begin DoDot:1
+13 SET FAC=0
FOR
SET FAC=$ORDER(COLS(DFN,FAC))
IF 'FAC
QUIT
Begin DoDot:2
+14 SET CNT=$GET(CNT)+1
+15 SET COLS(DFN,FAC)=CNT
+16 IF '$DATA(COLS("DFN",DFN))
SET COLS("DFN",DFN)=CNT
End DoDot:2
End DoDot:1
+17 ;
+18 SET COLS("CNT")=$GET(CNT)
+19 ;
+20 QUIT
ASK(DFNS) ;
+1 ;----- ASK WHICH PATIENTS TO COMPARE AND BUILD DFN(DFN) ARRAY
+2 ;
+3 NEW %1,AGE,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,DFN,DIC,DOB,OUT,SEX,SSN,X,Y
+4 ;
+5 SET OUT=0
+6 ;
+7 SET DIC="^DPT("
+8 SET DIC(0)="AEMQI"
+9 ;
+10 FOR
Begin DoDot:1
+11 DO ^DIC
+12 IF +Y'>0!($DATA(DUOUT))!($DATA(DUOUT))!($DATA(DTOUT))
SET OUT=1
+13 IF OUT
QUIT
+14 SET DFNS(+Y)=""
End DoDot:1
IF OUT
QUIT
+15 QUIT
SLDATE(X) ;
+1 ;----- RETURNS DATE IN MM/DD/YY FORMAT
+2 ;
+3 NEW Y
+4 SET Y=""
+5 IF X
Begin DoDot:1
+6 SET Y=$PIECE(X,".")
+7 IF 'Y
QUIT
+8 SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
End DoDot:1
+9 QUIT Y
CLEANUP ;
+1 ;----- HOUSEKEEPING
+2 ;
+3 KILL ^TMP("AZAX",$JOB,1)
+4 QUIT
