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

PXVP201.m

Go to the documentation of this file.
  1. PXVP201 ;BPIOFO/CLR - Environment routines ; 9/29/14 10:59am
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**201**;Aug 12, 1996;Build 41
  1. ;
  1. Q
  1. PRETRAN ;Load tables
  1. I $G(DUZ("AG"))'="V" Q
  1. M @XPDGREF@("PXVMAP")=^XTMP("PXVMAP")
  1. M @XPDGREF@("PXVCVX")=^XTMP("PXVCVX")
  1. Q
  1. ;
  1. PRE ;
  1. N DA,DIK,IEN
  1. I $G(DUZ("AG"))'="V" Q
  1. ;check that site has no IMMUNIZATION IENs between 1000 and 2000
  1. I '$D(^AUTTIVIS),($O(^AUTTIMM(1000))<2000) W !,"Invalid IEN in the IMMUNIZATION file - INSTALLATION ABORTED" S XPDABORT=1 Q
  1. ;delete data definitions in V IMMUNIZATION
  1. F DA=.08,.09,.1,.11,.12,.13,.14,.15 S DIK="^DD(9000010.11,",DA(1)=9000010.11 D ^DIK
  1. ;delete IMM MANUFACTURER
  1. I $D(^AUTTIMAN) S IEN=0,DIK="^AUTTIMAN(" D
  1. .F S IEN=$O(^AUTTIMAN(IEN)) Q:IEN'>0 D
  1. . . S DA=IEN D ^DIK
  1. ;delete VACCINE INFORMATION STATEMENT
  1. I $D(^AUTTIVIS) S IEN=0,DIK="^AUTTIVIS(" D
  1. .F S IEN=$O(^AUTTIVIS(IEN)) Q:IEN'>0 D
  1. . . S DA=IEN D ^DIK
  1. Q
  1. ;
  1. POST ;Post installation
  1. I $G(DUZ("AG"))'="V" Q ;do not install in non-VA environments
  1. N ERRCNT,PXVCPDT,XUMF
  1. K ^XTMP("PXVMAP"),^XTMP("PXVCVX"),^XTMP("PXVERR")
  1. M ^XTMP("PXVMAP")=@XPDGREF@("PXVMAP")
  1. M ^XTMP("PXVCVX")=@XPDGREF@("PXVCVX")
  1. I '$D(^XTMP("PXVMAP"))!('$D(^XTMP("PXVCVX"))) W !,"Mapping table not loaded - INSTALLATION ABORTED" S XPDQUIT=2 Q
  1. I '$D(^XTMP("PXVIMM")) M ^XTMP("PXVIMM","PXV")=^AUTTIMM
  1. S PXVCPDT=$$FMADD^XLFDT(DT,10)
  1. S ^XTMP("PXVMAP",0)=PXVCPDT_"^"_DT ;set purge ddt/creation dt
  1. S ^XTMP("PXVCVX",0)=PXVCPDT_"^"_DT
  1. S PXVCPDT=$$FMADD^XLFDT(DT,90)
  1. S ^XTMP("PXVIMM",0)=PXVCPDT_"^"_DT
  1. D DATA ;restores backup
  1. D REINDX ;re-indexex "B" crossref
  1. D MAP ;maps local entries to CVX code using data in ^XTMP("PXVMAP")
  1. ;Selects/updates standard entry for each CVX code
  1. ;using data in ^XTMP("PXVCVX")
  1. D SELECT
  1. D REMAIN ;updates non-standard entries
  1. D MAIL ;sends email to installer
  1. D MVDIAGS^PXVPST01 ;move data in V IMMUNIZATION
  1. Q
  1. ;
  1. MAP ;map local names to CVX codes
  1. S XUMF=1
  1. N PXVZ,PXVIEN,PXVERR,PXVC,I,PXVT
  1. F I=0:0 S I=$O(^XTMP("PXVMAP",I)) Q:I'>0 D
  1. . S PXVZ=$G(^XTMP("PXVMAP",I,0))
  1. . F PXVIEN=0:0 S PXVIEN=$O(^AUTTIMM("B",$P(PXVZ,U),PXVIEN)) Q:PXVIEN="" D
  1. . . S PXVC=$S($L($P(PXVZ,U,2))=1:"0"_($P(PXVZ,U,2)),1:$P(PXVZ,U,2))
  1. . . S PXVT(9999999.14,+PXVIEN_",",.03)=PXVC
  1. . . D UPDATE^DIE(,"PXVT",,"PXVERR")
  1. . . I $D(PXVERR) D ERROR(.PXVERR)
  1. Q
  1. ;
  1. SELECT ;Select standard in local file entries with CVX code
  1. N I,PXVSTIEN,PXVC,PXVZ,PXVOUT
  1. F I=0:0 S I=$O(^XTMP("PXVCVX",I)) Q:I="" D
  1. . S PXVZ=$G(^XTMP("PXVCVX",I,0))
  1. . ;handles one overflow line
  1. . S PXVZ=PXVZ_$G(^XTMP("PXVCVX",I,"OVF",1))
  1. . S PXVC=$P(PXVZ,U),PXVC=$S($L(PXVC)=1:"0"_PXVC,1:PXVC)
  1. . I '$D(^AUTTIMM("C",PXVC)) D Q
  1. . . S PXVZ="0^"_PXVZ
  1. . . S PXVOUT=$$STANDARD(PXVZ)
  1. . ;get ien of standard entry
  1. . S PXVSTIEN=$$ORDER(PXVC)
  1. . S PXVZ=PXVSTIEN_"^"_PXVZ
  1. . S PXVOUT=$$STANDARD(PXVZ)
  1. Q
  1. ;
  1. ORDER(CVX) ;determines precedence order for record
  1. ; 1: IEN<1000 & ACTIVE
  1. ; 2: IEN in local ns & ACTIVE
  1. ; 3: IEN in remote ns & ACTIVE
  1. ; 4: IEN<1000 & INACTIVE
  1. ; 5: IEN in local ns & INACTIVE
  1. ; 6: IEN in remote ns & INACTIVE
  1. N I,PXVIEN,PXVORD,PXVST,PXINST,PXVSTIEN,PXVRAY,PXVLAST,PXVSTOP
  1. N PXVREF,USE
  1. ;initialize precedence order array
  1. F I=1:1:6 S PXVRAY(I,0)=0 ;set o node
  1. ;get site local number space
  1. S PXINST=$$SITE^VASITE,PXINST=$P(PXINST,U,3) ;IA #10112
  1. ;process all existing records with same CVX code
  1. F PXVIEN=0:0 S PXVIEN=$O(^AUTTIMM("C",CVX,PXVIEN)) Q:PXVIEN="" D
  1. . S PXVST=$P(^AUTTIMM(PXVIEN,0),U,7)
  1. . S PXVORD=""
  1. . I PXVIEN<1000 S PXVORD=$S(PXVST="":1,1:4)
  1. . I PXVIEN>(PXINST*1000),PXVIEN<(PXINST+1*1000) S PXVORD=$S(PXVST="":2,1:5)
  1. . I $G(PXVORD)="" S PXVORD=$S(PXVST="":3,1:6)
  1. . S PXVRAY(PXVORD,PXVIEN)="",PXVRAY(PXVORD,0)=PXVRAY(PXVORD,0)+1
  1. ;identify national entry
  1. F PXVORD=1:1:6 D
  1. . S PXVIEN=$O(PXVRAY(PXVORD,0)) Q:PXVIEN=""
  1. . I $G(PXVSTIEN),(PXVIEN'=PXVSTIEN) D LOCAL(PXVIEN) Q ;rename losers
  1. . I PXVRAY(PXVORD,0)=1 S PXVSTIEN=PXVIEN Q
  1. . ;resolve ties
  1. . I PXVRAY(PXVORD,0)>1 D
  1. . . S USE=-1
  1. . . S PXVSTOP="9000010.11,""IP"","_PXVIEN_","
  1. . . F PXVIEN=0:0 S PXVIEN=$O(PXVRAY(PXVORD,PXVIEN)) Q:PXVIEN="" D
  1. . . . S PXVREF="^PXRMINDX(9000010.11,""IP"","_PXVIEN_")"
  1. . . . F I(PXVIEN)=0:1 S PXVREF=$Q(@PXVREF) Q:PXVREF'[PXVSTOP
  1. . . . I $G(I(PXVIEN))>USE S PXVSTIEN=PXVIEN,USE=I(PXVIEN)
  1. . . F IEN=0:0 S IEN=$O(I(IEN)) Q:IEN="" D
  1. . . . Q:IEN=PXVSTIEN
  1. . . . D LOCAL(IEN)
  1. Q PXVSTIEN
  1. ;
  1. STANDARD(PXVZ) ;set up standard record
  1. ;;ien of new entries =1000+CVX code
  1. ;;IEN/O^CVX^NAME^FULLNAME^COMB^STATUS^VIS^^CPT^^ACRONYM^PRODUCTNAME
  1. N PXV,PXVIEN,PXVERR,PXVT,PXVNM,PXVWP,PXVS
  1. S XUMF=1
  1. S (PXVIEN(1),PXV)=+$P(PXVZ,U)
  1. S PXVC=$P(PXVZ,U,2) ;CVX code
  1. I $L(PXVC)=1 S PXVC="0"_PXVC ;append zero
  1. ;status
  1. S PXVS=$P(PXVZ,U,6),PXVS=$S(PXVS["Active":"@",1:PXVS)
  1. ;add new one
  1. I '+$P(PXVZ,U) D
  1. . S PXVIEN(1)=1000+($P(PXVZ,U,2)),PXV="+1"
  1. ;avoid duplicate name errors
  1. S PXVNM=$P($G(^AUTTIMM(+$P(PXVZ,U),0)),U)
  1. I $$UP^XLFSTR($P(PXVZ,U,3))'=$$UP^XLFSTR(PXVNM) D
  1. . S PXVT(9999999.14,PXV_",",.01)=$$UP^XLFSTR($P(PXVZ,U,3)) ;NAME
  1. S PXVT(9999999.14,PXV_",",.07)=PXVS ;INACTIVE FLAG
  1. S PXVT(9999999.14,PXV_",",.03)=PXVC ;CVX CODE
  1. S PXVT(9999999.14,PXV_",",100)="NATIONAL" ;CLASS
  1. S PXVT(9999999.14,PXV_",",.2)=$P(PXVZ,U,5) ;COMBO
  1. S PXVT(9999999.14,PXV_",",8802)=$P(PXVZ,U,11) ;ACRONYM
  1. S PXVT(9999999.14,PXV_",",8803)="Y" ;SELECTABLE
  1. D UPDATE^DIE("E","PXVT","PXVIEN","PXVERR")
  1. I $D(PXVERR) D ERROR(.PXVERR) Q 1
  1. ;CDC FULL VACCINE NAME
  1. S PXVWP(1)=$P(PXVZ,U,4)
  1. S PXVWP(1)=$$UP^XLFSTR($E(PXVWP(1),1))_$E(PXVWP(1),2,$L(PXVWP(1)))
  1. D WP^DIE(9999999.14,PXVIEN(1)_",",2,"K","PXVWP","PXVERR")
  1. I $D(PXVERR) D ERROR(.PXVERR) Q 1
  1. ;VACCINE INFORMATION STATEMENT
  1. ;CDC PRODUCT NAME
  1. ;CODING SYSTEM->CODE
  1. D MANY(PXVIEN(1),.PXVZ)
  1. Q $G(PXVIEN(1))_$S($D(PXVERR):1,1:0)
  1. ;
  1. MANY(IEN,PXVZ) ;populates multiples
  1. N PXVL,PXVCOL,PXVITEM,I,PXVT,PXVERR,PXVLL,PXVREC
  1. ;VIS
  1. S PXVL=1,PXVCOL=$$UP^XLFSTR($P(PXVZ,U,7))
  1. ;muliple VIS with same name
  1. F I=1:1 S PXVITEM=$P(PXVCOL,"|",I) Q:PXVITEM="" D
  1. . F PXVREC=0:0 S PXVREC=$O(^AUTTIVIS("B",PXVITEM,PXVREC)) Q:PXVREC="" D
  1. . . S PXVT(9999999.144,"?+"_PXVL_","_IEN_",",.01)=PXVREC
  1. . . S PXVL=PXVL+1
  1. ;CDC PRODUCT NAMES
  1. S PXVCOL=$$UP^XLFSTR($P(PXVZ,U,12))
  1. F I=1:1 S PXVITEM=$P(PXVCOL,"|",I) Q:PXVITEM="" D
  1. . S PXVT(9999999.145,"?+"_PXVL_","_IEN_",",.01)=PXVITEM
  1. . S PXVL=PXVL+1
  1. ;CODING SYSTEM
  1. S PXVCOL="CPT"
  1. S PXVT(9999999.143,"?+"_PXVL_","_IEN_",",.01)=PXVCOL
  1. ;CPT CODES
  1. S PXVLL=PXVL,PXVL=PXVL+1,PXVCOL=$P(PXVZ,U,9)
  1. F I=1:1 S PXVITEM=$P(PXVCOL,"|",I) Q:PXVITEM="" D
  1. . S PXVT(9999999.1431,"?+"_PXVL_",?+"_PXVLL_","_IEN_",",.01)=PXVITEM
  1. . S PXVL=PXVL+1
  1. D UPDATE^DIE(,"PXVT",,"PXVERR")
  1. I $D(PXVERR) D ERROR(.PXVERR)
  1. Q
  1. ;
  1. REMAIN ;
  1. ;loop through file entries with no CVX code
  1. N PXVIEN,PXVZ
  1. S PXVIEN=0 F S PXVIEN=$O(^AUTTIMM(PXVIEN)) Q:PXVIEN'>0 D
  1. . S PXVZ=$G(^AUTTIMM(+PXVIEN,0))
  1. . Q:$P($G(^AUTTIMM(PXVIEN,100)),U)="N"
  1. . D LOCAL(PXVIEN,PXVZ)
  1. Q
  1. ;
  1. LOCAL(PXVIEN,PXVZ) ;
  1. N PXVT,PXVERR
  1. ;updates LOCAL record
  1. I '$D(PXVZ) S PXVZ=$G(^AUTTIMM(PXVIEN,0))
  1. I $P(PXVZ,U)'["(HISTORICAL)" S PXVT(9999999.14,PXVIEN_",",.01)=$P(PXVZ,U)_" (HISTORICAL)"
  1. S PXVT(9999999.14,PXVIEN_",",.07)="INACTIVE"
  1. S PXVT(9999999.14,PXVIEN_",",100)="LOCAL"
  1. S PXVT(9999999.14,PXVIEN_",",8803)="N"
  1. D UPDATE^DIE("E","PXVT",,"PXVERR")
  1. I $D(PXVERR) D ERROR(.PXVERR)
  1. Q
  1. ;
  1. ERROR(PXVERR) ;
  1. I '$D(^XTMP("PXVERR",0)) S ^XTMP("PXVERR",0)=$$FMADD^XLFDT(DT,10)_"^"_DT
  1. S ERRCNT=$S('$D(ERRCNT):1,1:ERRCNT+1)
  1. S $P(^XTMP("PXVERR",0),U,3)=ERRCNT
  1. M ^XTMP("PXVERR",ERRCNT)=PXVERR
  1. Q
  1. ;
  1. MAIL ;
  1. N PXVTXT,XMSUB,XMTEXT,PXVTXT,XMY,PXVOK,DIFROM
  1. S PXVOK=$G(^XTMP("PXVERR",0))>0
  1. S XMSUB="The IMMUNIZATION file update "
  1. S XMSUB=XMSUB_$S(PXVOK:"FAILED",1:"was SUCCESSFUL")
  1. S XMTEXT="PXVTXT("
  1. I PXVOK D
  1. . S PXVTXT(1)="Errors occurred during the update of the IMMUNIZATION file."
  1. . S PXVTXT(2)="Details of the errors are stored in ^XTMP(""PXVERR"") for the next 10 days."
  1. . S PXVTXT(3)="Please contact Product Support for assistance."
  1. I 'PXVOK D
  1. . S PXVTXT(1)="The IMMUNIZATION file has been successfully updated."
  1. S XMY(DUZ)=""
  1. D ^XMD
  1. Q
  1. ;
  1. DATA ;deletes data and copies from IMMUNIZATION
  1. N J,DA,DIK
  1. S XUMF=1
  1. I '$D(^XTMP("PXVIMM")) W !,"RESTORE FAILED>>GLOBAL DOES NOT EXIST" Q
  1. F J=0:0 S J=$O(^AUTTIMM(J)) Q:J'>0 D
  1. . S DA=J,DIK="^AUTTIMM(" D ^DIK
  1. S J=-1 F S J=$O(^XTMP("PXVIMM","PXV",J)) Q:J="" D
  1. . M ^AUTTIMM(J)=^XTMP("PXVIMM","PXV",J)
  1. ;M ^AUTTIMM=^XTMP("PXVIMM","PXV")
  1. Q
  1. REINDX ; re-indexes "B" xref for #.01 and #8801
  1. N DIK
  1. K ^AUTTIMM("B")
  1. S DIK="^AUTTIMM(",DIK(1)=".01^B" D ENALL^DIK
  1. S DIK="^AUTTIMM(",DIK(1)="8801^B" D ENALL^DIK
  1. Q
  1. IMMUNIZ ;
  1. N DIC,DIE,DA,DR,Y,XUMF
  1. S XUMF=1
  1. F PXV=0:0 S DIC="^AUTTIMM(",DIC(0)="AEQLN" D ^DIC Q:Y<0 D
  1. . S DIE="^AUTTIMM(",DR=".03;.07;.2;2;3;4;5;100;8802;8803",DA=+Y D ^DIE
  1. Q