BGPMUIMP ;IHS/MSC/MGH - Import taxonomy;20 Dec 2010 10:37;DU
;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
; Pharmacy List Update Functions
PHLFIL(DIR,FIL,TAX) ; EP - Import updates from a file
N ERR,POP,CNT,ATXFLG,TAXIEN
D OPEN^%ZISH(,DIR,FIL,"R")
I POP W "File not found",! Q
S ATXFLG=1
S TAXIEN="" S TAXIEN=$O(^ATXAX("B",TAX,TAXIEN))
Q:'TAXIEN ""
F CNT=1:1 D Q:POP
.N REC,LP
.U IO
.D READNXT^%ZISH(.REC)
.I '$L($G(REC)) S POP=1 Q
.S LP=0
.F S LP=$O(REC(LP)) Q:'LP S REC=REC_REC(LP)
.U IO(0)
.S ERR=$$PHLREC(REC)
.W:$L(ERR) CNT,": ",ERR,!
D CLOSE^%ZISH()
Q
PHLREC(REC,DEBUG) ; EP - Import updates from a single record
N CODE,AIEN
S NAME=$G(REC)
S AIEN="+1,"_TAXIEN_","
S FDA(9002226.02101,AIEN,.01)=NAME
S FDA(9002226.02101,AIEN,.02)=NAME
D UPDATE^DIE(,"FDA","IEN","ERR")
K FDA,IEN,ERR
Q ""
LLISTFIL(DIR,FIL,TAX) ; EP - Import updates from a file
N ERR,POP,CNT,ATXFLG,TAXIEN
D OPEN^%ZISH(,DIR,FIL,"R")
I POP W "File not found",! Q
S ATXFLG=1
S TAXIEN="" S TAXIEN=$O(^ATXAX("B",TAX,TAXIEN))
Q:'TAXIEN ""
F CNT=1:1 D Q:POP
.N LST,LP
.U IO
.D READNXT^%ZISH(.LST)
.I '$L($G(LST)) S POP=1 Q
.S LP=0
.F S LP=$O(LST(LP)) Q:'LP S LST=LST_LST(LP)
.U IO(0)
.S ERR=$$PHLLST(LST)
.W:$L(ERR) CNT,": ",ERR,!
D CLOSE^%ZISH()
Q
PHLLST(LST,DEBUG) ; EP - Import updates from a single record
N REC
F LP=1:1 S REC=$P(LST,", ",LP) Q:REC="" D
.N CODE,AIEN
.S NAME=$G(REC)
.S AIEN="+1,"_TAXIEN_","
.S FDA(9002226.02101,AIEN,.01)=NAME
.S FDA(9002226.02101,AIEN,.02)=NAME
.D UPDATE^DIE(,"FDA","IEN","ERR")
.K FDA,IEN,ERR
Q ""
BGPMUIMP ;IHS/MSC/MGH - Import taxonomy;20 Dec 2010 10:37;DU
+1 ;;11.0;IHS CLINICAL REPORTING;**4**;JAN 06, 2011;Build 84
+2 ; Pharmacy List Update Functions
PHLFIL(DIR,FIL,TAX) ; EP - Import updates from a file
+1 NEW ERR,POP,CNT,ATXFLG,TAXIEN
+2 DO OPEN^%ZISH(,DIR,FIL,"R")
+3 IF POP
WRITE "File not found",!
QUIT
+4 SET ATXFLG=1
+5 SET TAXIEN=""
SET TAXIEN=$ORDER(^ATXAX("B",TAX,TAXIEN))
+6 IF 'TAXIEN
QUIT ""
+7 FOR CNT=1:1
Begin DoDot:1
+8 NEW REC,LP
+9 USE IO
+10 DO READNXT^%ZISH(.REC)
+11 IF '$LENGTH($GET(REC))
SET POP=1
QUIT
+12 SET LP=0
+13 FOR
SET LP=$ORDER(REC(LP))
IF 'LP
QUIT
SET REC=REC_REC(LP)
+14 USE IO(0)
+15 SET ERR=$$PHLREC(REC)
+16 IF $LENGTH(ERR)
WRITE CNT,": ",ERR,!
End DoDot:1
IF POP
QUIT
+17 DO CLOSE^%ZISH()
+18 QUIT
PHLREC(REC,DEBUG) ; EP - Import updates from a single record
+1 NEW CODE,AIEN
+2 SET NAME=$GET(REC)
+3 SET AIEN="+1,"_TAXIEN_","
+4 SET FDA(9002226.02101,AIEN,.01)=NAME
+5 SET FDA(9002226.02101,AIEN,.02)=NAME
+6 DO UPDATE^DIE(,"FDA","IEN","ERR")
+7 KILL FDA,IEN,ERR
+8 QUIT ""
LLISTFIL(DIR,FIL,TAX) ; EP - Import updates from a file
+1 NEW ERR,POP,CNT,ATXFLG,TAXIEN
+2 DO OPEN^%ZISH(,DIR,FIL,"R")
+3 IF POP
WRITE "File not found",!
QUIT
+4 SET ATXFLG=1
+5 SET TAXIEN=""
SET TAXIEN=$ORDER(^ATXAX("B",TAX,TAXIEN))
+6 IF 'TAXIEN
QUIT ""
+7 FOR CNT=1:1
Begin DoDot:1
+8 NEW LST,LP
+9 USE IO
+10 DO READNXT^%ZISH(.LST)
+11 IF '$LENGTH($GET(LST))
SET POP=1
QUIT
+12 SET LP=0
+13 FOR
SET LP=$ORDER(LST(LP))
IF 'LP
QUIT
SET LST=LST_LST(LP)
+14 USE IO(0)
+15 SET ERR=$$PHLLST(LST)
+16 IF $LENGTH(ERR)
WRITE CNT,": ",ERR,!
End DoDot:1
IF POP
QUIT
+17 DO CLOSE^%ZISH()
+18 QUIT
PHLLST(LST,DEBUG) ; EP - Import updates from a single record
+1 NEW REC
+2 FOR LP=1:1
SET REC=$PIECE(LST,", ",LP)
IF REC=""
QUIT
Begin DoDot:1
+3 NEW CODE,AIEN
+4 SET NAME=$GET(REC)
+5 SET AIEN="+1,"_TAXIEN_","
+6 SET FDA(9002226.02101,AIEN,.01)=NAME
+7 SET FDA(9002226.02101,AIEN,.02)=NAME
+8 DO UPDATE^DIE(,"FDA","IEN","ERR")
+9 KILL FDA,IEN,ERR
End DoDot:1
+10 QUIT ""
