- 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 ""
