118 lines
3.5 KiB
Mathematica
118 lines
3.5 KiB
Mathematica
PPPPRT4 ;ALB/DMB - FFX PRINT ROUTINES ; 3/13/92
|
|
;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
SRTBYNM(OUTARRY) ; Sort the FFX file by name
|
|
;
|
|
; This function will order through the APOV xref of the FFX file
|
|
; and return an array containing the patient info and place of visit
|
|
; info.
|
|
;
|
|
; The output array is in the form:
|
|
;
|
|
; @OUTARRY@(PATIENT_NAME)=DOB^SSN
|
|
; @OUTARRY@(PATIENT_NAME,STATION_NAME)=NUMBER^DOMAIN^LDOV
|
|
;
|
|
N DIC,DA,PATDFN,DR,DIQ,PATNAME,PATDOB,PATSSN,PPPTMP,STANAME,STANUM
|
|
N STADOM,LDOV,TPATS,TSTATION,SNIFN,FFXIFN
|
|
;
|
|
K @OUTARRY
|
|
;
|
|
S TPATS=0
|
|
S TSTATION=0
|
|
;
|
|
; Order through the APOV xref and get the data for each dfn
|
|
;
|
|
F PATDFN=0:0 D Q:PATDFN=""
|
|
.S PATDFN=$O(^PPP(1020.2,"APOV",PATDFN)) Q:PATDFN=""
|
|
.S DIC=2,DA=PATDFN,DR=".01;.03;.09",DIQ="PPPTMP"
|
|
.D EN^DIQ1 Q:'$D(PPPTMP)
|
|
.S PATNAME=PPPTMP(2,PATDFN,.01)
|
|
.S PATDOB=PPPTMP(2,PATDFN,.03)
|
|
.S PATSSN=PPPTMP(2,PATDFN,.09)
|
|
.S @OUTARRY@(PATNAME)=PATDOB_"^"_PATSSN
|
|
.S TPATS=TPATS+1
|
|
.K PPPTMP
|
|
.F SNIFN=0:0 D Q:SNIFN=""
|
|
..S SNIFN=$O(^PPP(1020.2,"APOV",PATDFN,SNIFN)) Q:SNIFN=""
|
|
..S FFXIFN=$O(^PPP(1020.2,"APOV",PATDFN,SNIFN,"")) Q:FFXIFN=""
|
|
..S DIC=4,DA=SNIFN,DR=".01;99",DIQ="PPPTMP"
|
|
..D EN^DIQ1 Q:'$D(PPPTMP)
|
|
..S STANAME=PPPTMP(4,SNIFN,.01)
|
|
..S STANUM=PPPTMP(4,SNIFN,99)
|
|
..K PPPTMP
|
|
..S LDOV=$$I2EDT^PPPCNV1($P($G(^PPP(1020.2,FFXIFN,0)),"^",3))
|
|
..S STADOM=$P($G(^PPP(1020.2,FFXIFN,1)),"^",5)
|
|
..S @OUTARRY@(PATNAME,STANAME)=STANUM_"^"_STADOM_"^"_LDOV
|
|
..S TSTATION=TSTATION+1
|
|
Q TPATS_"^"_TSTATION
|
|
;
|
|
SRTBYSTA(OUTARRY) ; Sort the FFX file by STATION
|
|
;
|
|
; This function will order through the ARPOV xref of the FFX file
|
|
; and return an array containing the patient info and place of visit
|
|
; info.
|
|
;
|
|
; The output array is in the form:
|
|
;
|
|
; @OUTARRY@(STATION_NAME)=NUMBER^DOMAIN
|
|
; @OUTARRY@(STATION_NAME_PATIENT_NAME)=DOB^SSN^LDOV
|
|
;
|
|
N DIC,DA,PATDFN,DR,DIQ,PATNAME,PATDOB,PATSSN,PPPTMP,STANAME,STANUM
|
|
N STADOM,LDOV,TPATS,TSTATION,SNIFN,FFXIFN
|
|
;
|
|
K @OUTARRY
|
|
;
|
|
S TPATS=0
|
|
S TSTATION=0
|
|
;
|
|
; Order through the ARPOV xref and get the data for each dfn
|
|
;
|
|
F SNIFN=0:0 D Q:SNIFN=""
|
|
.S SNIFN=$O(^PPP(1020.2,"ARPOV",SNIFN)) Q:SNIFN=""
|
|
.S DIC=4,DA=SNIFN,DR=".01;99",DIQ="PPPTMP"
|
|
.D EN^DIQ1 Q:'$D(PPPTMP)
|
|
.S STANAME=PPPTMP(4,SNIFN,.01)
|
|
.S STANUM=PPPTMP(4,SNIFN,99)
|
|
.K PPPTMP
|
|
.S TSTATION=TSTATION+1
|
|
.F PATDFN=0:0 D Q:PATDFN=""
|
|
..S PATDFN=$O(^PPP(1020.2,"ARPOV",SNIFN,PATDFN)) Q:PATDFN=""
|
|
..S DIC=2,DA=PATDFN,DR=".01;.03;.09",DIQ="PPPTMP"
|
|
..D EN^DIQ1 Q:'$D(PPPTMP)
|
|
..S PATNAME=PPPTMP(2,PATDFN,.01)
|
|
..S PATDOB=PPPTMP(2,PATDFN,.03)
|
|
..S PATSSN=PPPTMP(2,PATDFN,.09)
|
|
..S FFXIFN=$O(^PPP(1020.2,"ARPOV",SNIFN,PATDFN,"")) Q:FFXIFN=""
|
|
..S LDOV=$$I2EDT^PPPCNV1($P($G(^PPP(1020.2,FFXIFN,0)),"^",3))
|
|
..S STADOM=$P($G(^PPP(1020.2,FFXIFN,1)),"^",5)
|
|
..S @OUTARRY@(STANAME)=STANUM_"^"_STADOM
|
|
..S @OUTARRY@(STANAME,PATNAME)=PATDOB_"^"_PATSSN_"^"_LDOV
|
|
..S TPATS=TPATS+1
|
|
..K PPPTMP
|
|
Q TSTATION_"^"_TPATS
|
|
;
|
|
NAMESRT(INARRY,OUTARRY) ; Sort the clinic list by name and get SSN & DOB.
|
|
;
|
|
N DIC,DA,PATDFN,DR,DIQ,NAME,DOB,SSN,PPPTMP
|
|
;
|
|
; Make sure the output array is empty
|
|
;
|
|
K @OUTARRY,PPPTMP
|
|
;
|
|
S TENTRY=0
|
|
;
|
|
; Order through the in array and get the data for each DFN.
|
|
;
|
|
F PATDFN=0:0 D Q:PATDFN=""
|
|
.S PATDFN=$O(@INARRY@(PATDFN)) Q:PATDFN=""
|
|
.S DIC=2,DA=PATDFN,DR=".01;.03;.09",DIQ="PPPTMP"
|
|
.D EN^DIQ1 Q:'$D(PPPTMP)
|
|
.S NAME=PPPTMP(2,PATDFN,.01)
|
|
.S DOB=PPPTMP(2,PATDFN,.03)
|
|
.S SSN=PPPTMP(2,PATDFN,.09)
|
|
.S @OUTARRY@(NAME,PATDFN)=DOB_"^"_SSN
|
|
.S TENTRY=TENTRY+1
|
|
.K PPPTMP
|
|
Q TENTRY
|