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

BVCONV1.m

Go to the documentation of this file. 
  1. BVCONV1 ; IHS/ITSC/JDH - PCC CONVERSION PROCESS; [ 12/06/2002  10:05 AM ]
  1.  ;;2.0;IHS V FILES 200 CONVERSION;;MAR 29, 2002
  1.  W !!,"Use PRECMP^BVCONV to call this routine." Q
  1.  ;
  1. EN ; EP PCC conversion routine
  1.  N X,BVCERR,POP,BVCEXP,BVCPRNM
  1.  S BVCQ=$D(^BVCONV(1,"VARS"))
  1.  S X=$ST($ST-1,"PLACE")
  1.  I 'BVCQ,X'["O+3^BVCONV" W !,"This routine must be called from the interface",!,"aborting" Q  ;caller must be from the interface
  1.  S X=$ST($ST-1,"MCODE")
  1.  I 'BVCQ,X'["D EN^BVCONV1 ; run the conversion" W !,"This routine must be called from the interface",!,"aborting" Q  ; caller must be this
  1.  D INIT
  1.  D CONV ; convert
  1.  ; set PCC Conversion flag in ^AUTTSITE
  1.  D:'BVCERR!BVCPRCP POST
  1.  Q
  1.  Q
  1.  ;
  1. CONV ; convert PCC files to use file 200 vs 6 pointer.    
  1.  N X
  1.  S X=$ST($ST-1,"PLACE")
  1.  I 'BVCQ,'BVCERR,X'["EN+8^BVCONV1" W !,"this is not a valid entry point",!,"aborting" Q  ;caller must be from tag EN
  1.  S X=$ST($ST-1,"MCODE")
  1.  I 'BVCQ,'BVCERR,X'["D CONV ;" W !,"this is not a valid entry point",!,"aborting" Q  ;convert" ; caller must be this   ;TASSC/MFD changed X'= to X'[ to allow functioning with Cache
  1.  ;
  1.  N BVCLPCT,BVCNUMB,BVCDA,BVCFLD,BVCP6,BVCPRNM,BVCP200,BVCNPNM,DA,DR,BVC
  1.  S BVC=1 ; required for the input transform of field .01 of file 9000010.06
  1.  S BVCNUMB=90000,X="ERR^BVCONV1",@^%ZOSF("TRAP")
  1.  ;S BVCNUMB=9000010.08 ; TEST
  1.  F  S BVCNUMB=$O(BVCONV(BVCNUMB)) Q:'BVCNUMB  S BVCREC=BVCONV(BVCNUMB) D
  1.  .W !!,$S(BVCPRCP:"Checking",1:"Converting")_" file: "_BVCNUMB,!!
  1.  .S X=$P($G(^BVCONV1(BVCPRCP,BVCNUMB)),U,4,6)
  1.  .S BVCNUCT=+$P(X,U,2),BVCCVCT=+X,BVCGNCT=+$P(X,U,3) ;zero field counts
  1.  .S X=$G(^BVCONV1(BVCPRCP,BVCNUMB)) Q:X  ;file is already converted
  1.  .S $P(^BVCONV1(BVCPRCP,BVCNUMB),U,3)=$H
  1.  .S BVCDA=+$P(X,U,2) ; starting record number
  1.  .S BVCROOT="^"_$P(BVCREC,U),BVCELMS=$P(BVCREC,U,2,99)
  1.  .I '$D(@$P(BVCROOT,"(")) Q
  1.  .; loop through target file
  1.  .F BVCLPCT=1:1 S BVCDA=$O(@(BVCROOT_BVCDA_")")) Q:'BVCDA  D
  1.  ..;
  1.  ..W:'(BVCLPCT#500) "."
  1.  .. I 'BVCPRCP,'BVCLPCT#1000,$D(^%ZTSCH("RUN")) D
  1.  ...S BVCP6=0 D ERROR("TASKMAN RE-SUTDOWN") D SMAN^ZTMKU,SSUB^ZTMKU ; keep Takman down
  1.  ..S DA=BVCDA,DR=""
  1.  ..I '$D(@(BVCROOT_BVCDA_",0)")) Q
  1.  ..; get file elements to convert
  1.  ..F BVCI=1:1 S BVCELM=$P(BVCELMS,U,BVCI) Q:'$L(BVCELM)  D
  1.  ...; create parse string. This may eliminate processing steps
  1.  ...S BVCNODE=BVCROOT_BVCDA_","_$P(BVCELM,";",3)_")",BVCPCE=$P(BVCELM,";",4)
  1.  ...S BVCDATA=$G(@BVCNODE),BVCP6=$P(BVCDATA,U,BVCPCE) ; file 6 pointer
  1.  ...I 'BVCP6 D  Q  ; no entry. no conversion needed
  1.  ....S BVCNUCT=BVCNUCT+1
  1.  ...;get name for comparison. 
  1.  ...S BVCFLD=$P(BVCELM,";",2)
  1.  ...S BVCCVCT=BVCCVCT+1,BVCP200=$$RESOLVE(BVCP6) ;get current field value and 200 ptr
  1.  ...Q:'BVCP200  ; no file 200 pointer, no conversion - THIS SHOULD NEVER BE
  1.  ...Q:BVCPRCP  ; cheking compile only - do not change databAse.
  1.  ...;I BVCELM S $P(@BVCNODE,U,BVCPCE)=BVCP200 ; set directly
  1.  ...;E  D  ; set through fileman
  1.  ...S DR=DR_$E(";",DR>0)_BVCFLD_$S(BVCFLD'=.01:"////",1:"///`")_BVCP200
  1.  ..; record last ien used
  1.  ..I DR S DIE=BVCNUMB D ^DIE I $D(Y) S BVCP200=BVCP6,(BVCPRNM,BVCNPNM)=$P($G(^DIC(16,+BVCP6,0)),U) D ERROR("NO CHANGE INPUT XFRM ERROR")
  1.  ..;
  1.  ..; record status
  1.  ..S $P(^BVCONV1(BVCPRCP,BVCNUMB),U,2)=BVCDA
  1.  ..S $P(^BVCONV1(BVCPRCP,BVCNUMB),U,4,6)=BVCCVCT_U_BVCNUCT_U_BVCGNCT
  1.  .; record completion of file
  1.  .S $P(^BVCONV1(BVCPRCP,BVCNUMB),U,1)=$H
  1.  Q
  1.  ;
  1. RESOLVE(BVCP6) ; convert from a file 6 to 200 pointer
  1.  ; the navigations from file 2 to 200 must exit
  1.  ; this tag verifies a file 200 entry is used
  1.  K BVCPRNM
  1.  S BVCFLG=0 ;use default flag 0 = NO 1 = YES
  1.  S BVCFLG1=1 ; do the checks
  1.  ; defaults
  1.  S BVCP200=BVCDFDC
  1.  S BVCNPNM=BVCDFNM
  1.  ;
  1.  ; do not reprocess
  1.  S X=$G(^BVCONV(1,"CONV",BVCP6)) D:X
  1.  .S BVCP200=+X
  1.  .S BVCNPNM=$P(X,U,2)
  1.  .S BVCEXP=$P(X,U,3)
  1.  .S BVCFLG1=0
  1.  .I $L(BVCEXP) D ERROR(BVCEXP) S BVCFLG=1
  1.  ;
  1.  I BVCFLG1 D
  1.  .S BVCPTR=$G(^DIC(16,+BVCP6,"A3"))
  1.  .I 'BVCPTR D
  1.  ..D ERROR("No A16 XREF & A3 node") S BVCFLG=1
  1.  .E  D
  1.  ..S BVCPRNM=$P($G(^DIC(16,+BVCP6,0)),U)
  1.  ..S BVCNP=$P($G(^VA(200,+BVCPTR,0)),U)
  1.  ..I '$L(BVCNP) D ERROR("No file 200 entry") S BVCFLG=1 Q
  1.  ..I '$D(^VA(200,"AK.PROVIDER",BVCNP,BVCPTR)) D ERROR("No AK.PROVIDER xref") S BVCFLG=1 ; no provider key or xref
  1.  ..I BVCPRCP,BVCPRNM'=BVCNP D ERROR("Not same provider names") S BVCFLG=1
  1.  ..S:'BVCFLG BVCP200=BVCPTR,BVCNPNM=BVCNP ; ok to use provider (not default)
  1.  S:BVCFLG BVCGNCT=BVCGNCT+1 ;default use count
  1.  S:BVCFLG1 $P(^BVCONV(1,"CONV",BVCP6),U,1,2)=BVCP200_U_$G(BVCPRNM)
  1.  Q BVCP200 ; use resolved pointer or user defined default
  1.  ;
  1. ERROR(BVCERTP) ; record an error
  1.  N DIC,DLAYGO,X,DD,DO,BVCORIG
  1.  S:BVCFLG1 $P(^BVCONV(1,"CONV",BVCP6),U,3)=BVCERTP
  1.  S BVCORIG=+$G(^DIC(16,+BVCP6,"A3"))
  1.  S DIC="^BVC(90098,",DIC(0)="L",DLAYGO=9003102,X=BVCERTP
  1.  S DIC("DR")=".02////"_+$G(BVCNUMB)_";.03////"_+$G(BVCDA)_";.04////"_+$G(BVCFLD)_";.05////"_+$G(BVCP6)_";.06////"_$S($L($G(BVCPRNM)):BVCPRNM,1:"NOT AVAILABLE")
  1.  S DIC("DR")=DIC("DR")_";.07////"_$G(BVCP200)_";.08////"_$S($L($G(BVCNPNM)):BVCNPNM,1:"NOT AVAILABLE")_";.09////"_$$HTE^XLFDT($H)_";1////"_BVCORIG D FILE^DICN
  1.  Q
  1.  ;
  1. ERR ; record an error
  1.  N X S BVCERR=BVCERR+1
  1.  S X=$$EC^%ZOSV
  1.  W !!,"An error has occured",!,X,!,"Aborting the conversion",!!
  1.  D ERROR(X) ;error
  1.  I BVCPRCP,BVCERR<11 G CONV
  1.  D ^%ZTER
  1.  D XMD^BVCONV(0) ; email abort message
  1.  Q
  1.  ;
  1. INIT ; initialize VARIABLES
  1.  N BVCSTRT
  1.  S BVCERR=0
  1.  ; get variables from ^BVCONV
  1.  S I="" F  S I=$O(^BVCONV(1,"VARS",I)) Q:I=""  S @I=^(I) ; get variables from BVCONV routine
  1.  I BVCQ D  ; reset device variables in jobbed process. IOP defined in ^BVCONV(1,"VARS",
  1.  .S ZTQUEUED=1
  1.  .D ^XBKVAR
  1.  .N %ZIS S:IOT="HFS" %ZIS("IOPAR")=IOPAR
  1.  .S %ZIS=0 D ^%ZIS
  1.  U IO W:$E(IOST,1,2)'="C-"!(ION="HFS") !!,"The conversion "_$S(BVCPRCP:"check ",1:"")_"started "_$$HTE^XLFDT($H)
  1.  S ^BVCONV1(BVCPRCP,0)="PCC file conversion "_$S(BVCPRCP:"check ",1:"")_"to use file 200 vs. 6 pointers"
  1.  S BVCERR=0
  1.  D ELEMLST^BVCONV(1) ; setup conversion table
  1.  S BVCSTRT=$P($G(^BVCONV1(BVCPRCP,"RUN TIMES")),U)
  1.  I 'BVCSTRT D
  1.  .N DIK,DA,BVCERCT
  1.  .W !,"Deleting FILE 200 ERROR FILE entries."
  1.  .S BVCERCT=$O(^BVC(90098,"A"),-1) F DA=1:1:BVCERCT W:'(DA#100) "." S DIK="^BVC(90098," D ^DIK
  1.  .S ^BVCONV1(BVCPRCP,"RUN TIMES")=$H
  1.  ;default name
  1.  S BVCDFNM=$P($G(^VA(200,BVCDFDC,0)),U)
  1.  Q
  1.  ;
  1. POST ; execute after conversion
  1.  N BVCCVTM
  1.  S $P(^BVCONV1(BVCPRCP,"RUN TIMES"),U,2)=$H
  1.  S X=^BVCONV1(BVCPRCP,"RUN TIMES") S BVCCVTM=$$HDIFF^XLFDT($P(X,U,2),$P(X,U),2)
  1.  I BVCPRCP D
  1.  .S BVCCVTM=$J(BVCCVTM*5.5/3600,3,2)
  1.  .W !!,"The PCC conversion will take approximately "_BVCCVTM_" hours."
  1.  .D XMD^BVCONV(2,BVCCVTM) ; email of check completion
  1.  .K ^BVCONV(1)
  1.  E  D
  1.  .S $P(^AUTTSITE(1,0),U,22)=1 ; FM is not used here because the uneditable field may be valued
  1.  .; send message of completion
  1.  .S BVCCVTM=$J(BVCCVTM/3600,3,2)
  1.  .D XMD^BVCONV(1,BVCCVTM) ; email completion message
  1.  .W !,"Converting Q-MAN to use file 200 vs 6"
  1.  .W !,"Q-MAN is "_$S($$AMQQ200:"",1:"NOT ")_"converted"
  1.  .W !!,"The conversion completed "_$$HTE^XLFDT($H)
  1.  .W !!,"The conversion ran for "_BVCCVTM_" hours."
  1.  .W !!,"Deleteing conversion routines.",!! D DELETE^BVCONV ; delete conversion routines
  1.  .;  kill pcc run 
  1.  .K ^BVCONV(1),^BVCHK(1)
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. AMQQ200() ; convert Q-man
  1.  N BVCFLG S BVCFLG=0
  1.  I ^AMQQ(1,203,4,1,1)["^DIC(16," D  ; ok to convert
  1.  .D META^AMQQ200,DIE^AMQQ200 S BVCFLG=1
  1.  Q BVCFLG
  1.  ;