APCD206F ; IHS/CMI/TUCSON - DATA ENTRY PATCH 6 [ 03/24/03 2:14 PM ]
;;2.0;IHS RPMS/PCC Data Entry;**6**;MAR 09, 1999
;
W !,"checking V LAB for correct provider entries...Hold on..."
I $P(^AUTTSITE(1,0),U,22)=1 Q
I $P(^DD(9000010.06,.01,0),U,2)[200 Q
I $P(^DD(9000010.09,1202,0),U,2)[6 Q ;fix already ran or never installed patch 5
FIX ;
D ^APC7INIT
S APCDLAST=$P(^AUPNVLAB(0),U,3)
;loop through V LAB since date of patch 5 install and fix V LAB 1202
S APCDII=$O(^XPD(9.7,"B","APCD*2.00*5",0))
I 'APCDII W !!,"APCD patch 5 never installed. No need to run post init." K APCDII Q
S APCDID=$P($G(^XPD(9.7,APCDII,1)),U)
S APCDID=$P(APCDID,".")
F S APCDID=$O(^AUPNVSIT("B",APCDID)) Q:APCDID'=+APCDID D
.S APCDV=0 F S APCDV=$O(^AUPNVSIT("B",APCDID,APCDV)) Q:APCDV'=+APCDV D
..Q:'$D(^AUPNVLAB("AD",APCDV)) ;no v labs
..S APCDL=0 F S APCDL=$O(^AUPNVLAB("AD",APCDV,APCDL)) Q:APCDL'=+APCDL D
...Q:APCDL>APCDLAST
...Q:$P($G(^AUPNVLAB(APCDL,12)),U,2)=""
...S APCDOLD=$P($G(^AUPNVLAB(APCDL,12)),U,2) ;is a file 200 ptr
...Q:'$D(^VA(200,APCDOLD,0))
...S APCDNEW=$P(^VA(200,APCDOLD,0),U,16) ;file 6 ptr
...Q:APCDNEW=""
...S Y=$$TXLGN($P(^AUPNVLAB(APCDL,0),U,6),APCDL)
...I Y]"",Y'=$P(^DIC(16,APCDNEW,0),U,1) Q
...S DA=APCDL,DIE="^AUPNVLAB(",DR="1202///`"_APCDNEW D ^DIE D ^XBFMK
...W ":",APCDL
...Q
..Q
.Q
D CHECK
W !!,"all done"
Q
;
TXLGN(ACC,VF) ;
NEW A,B,C,G,P
I $G(ACC)="" Q ""
I $G(VF)="" Q ""
S P="",G=0,A=0 F S A=$O(^BLRTXLOG("D",ACC,A)) Q:A'=+A!(G) D
.S B=$P($G(^BLRTXLOG(A,1)),U,5)
.I B=VF S G=1,P=$P($G(^BLRTXLOG(A,11)),U,4) I P S P=$P(^VA(200,P,0),U)
.Q
Q P
;
C ;
S X=0 F S X=$O(^VA(200,X)) Q:X'=+X D
.S Y=$P(^VA(200,X,0),U,16)
.Q:Y=""
.I $P(^DIC(16,Y,0),U)'=$P(^VA(200,X,0),U) W !,Y," ",X
.Q
Q
CHECK ;
NEW VFP,TXP,NEW,DA,DIE,APCDX,VF
W !,"hang on...checking..."
S APCDX=0 F S APCDX=$O(^BLRTXLOG(APCDX)) Q:APCDX'=+APCDX D
.I $P($G(^BLRTXLOG(APCDX,1)),U,3)<3021001 Q
.Q:$P(^BLRTXLOG(APCDX,1),U,4)'=9000010.09
.S VF=$P(^BLRTXLOG(APCDX,1),U,5)
.Q:VF=""
.Q:'$D(^AUPNVLAB(VF,12))
.Q:'$D(^AUPNVLAB(VF,0))
.S VFP=$$VAL^XBDIQ1(9000010.09,VF,1202)
.S TXP=$$VAL^XBDIQ1(9009022,APCDX,1104)
.I VFP=TXP Q ;a match
.I $P(VFP,",")=$P(TXP,",") Q
.;I VFP'=TXP W !,"does not match: VF=",VF," TX=",APCDX," ",VFP," ",TXP
.S NEW=$P(^BLRTXLOG(APCDX,11),U,4),NEW=$P(^VA(200,NEW,0),U,16)
.Q:NEW=""
.S DA=VF,DIE="^AUPNVLAB(",DR="1202///`"_NEW D ^DIE,^XBFMK
.Q
W !,"all done"
Q
APCD206F ; IHS/CMI/TUCSON - DATA ENTRY PATCH 6 [ 03/24/03 2:14 PM ]
+1 ;;2.0;IHS RPMS/PCC Data Entry;**6**;MAR 09, 1999
+2 ;
+3 WRITE !,"checking V LAB for correct provider entries...Hold on..."
+4 IF $PIECE(^AUTTSITE(1,0),U,22)=1
QUIT
+5 IF $PIECE(^DD(9000010.06,.01,0),U,2)[200
QUIT
+6 ;fix already ran or never installed patch 5
IF $PIECE(^DD(9000010.09,1202,0),U,2)[6
QUIT
FIX ;
+1 DO ^APC7INIT
+2 SET APCDLAST=$PIECE(^AUPNVLAB(0),U,3)
+3 ;loop through V LAB since date of patch 5 install and fix V LAB 1202
+4 SET APCDII=$ORDER(^XPD(9.7,"B","APCD*2.00*5",0))
+5 IF 'APCDII
WRITE !!,"APCD patch 5 never installed. No need to run post init."
KILL APCDII
QUIT
+6 SET APCDID=$PIECE($GET(^XPD(9.7,APCDII,1)),U)
+7 SET APCDID=$PIECE(APCDID,".")
+8 FOR
SET APCDID=$ORDER(^AUPNVSIT("B",APCDID))
IF APCDID'=+APCDID
QUIT
Begin DoDot:1
+9 SET APCDV=0
FOR
SET APCDV=$ORDER(^AUPNVSIT("B",APCDID,APCDV))
IF APCDV'=+APCDV
QUIT
Begin DoDot:2
+10 ;no v labs
IF '$DATA(^AUPNVLAB("AD",APCDV))
QUIT
+11 SET APCDL=0
FOR
SET APCDL=$ORDER(^AUPNVLAB("AD",APCDV,APCDL))
IF APCDL'=+APCDL
QUIT
Begin DoDot:3
+12 IF APCDL>APCDLAST
QUIT
+13 IF $PIECE($GET(^AUPNVLAB(APCDL,12)),U,2)=""
QUIT
+14 ;is a file 200 ptr
SET APCDOLD=$PIECE($GET(^AUPNVLAB(APCDL,12)),U,2)
+15 IF '$DATA(^VA(200,APCDOLD,0))
QUIT
+16 ;file 6 ptr
SET APCDNEW=$PIECE(^VA(200,APCDOLD,0),U,16)
+17 IF APCDNEW=""
QUIT
+18 SET Y=$$TXLGN($PIECE(^AUPNVLAB(APCDL,0),U,6),APCDL)
+19 IF Y]""
IF Y'=$PIECE(^DIC(16,APCDNEW,0),U,1)
QUIT
+20 SET DA=APCDL
SET DIE="^AUPNVLAB("
SET DR="1202///`"_APCDNEW
DO ^DIE
DO ^XBFMK
+21 WRITE ":",APCDL
+22 QUIT
End DoDot:3
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
+25 DO CHECK
+26 WRITE !!,"all done"
+27 QUIT
+28 ;
TXLGN(ACC,VF) ;
+1 NEW A,B,C,G,P
+2 IF $GET(ACC)=""
QUIT ""
+3 IF $GET(VF)=""
QUIT ""
+4 SET P=""
SET G=0
SET A=0
FOR
SET A=$ORDER(^BLRTXLOG("D",ACC,A))
IF A'=+A!(G)
QUIT
Begin DoDot:1
+5 SET B=$PIECE($GET(^BLRTXLOG(A,1)),U,5)
+6 IF B=VF
SET G=1
SET P=$PIECE($GET(^BLRTXLOG(A,11)),U,4)
IF P
SET P=$PIECE(^VA(200,P,0),U)
+7 QUIT
End DoDot:1
+8 QUIT P
+9 ;
C ;
+1 SET X=0
FOR
SET X=$ORDER(^VA(200,X))
IF X'=+X
QUIT
Begin DoDot:1
+2 SET Y=$PIECE(^VA(200,X,0),U,16)
+3 IF Y=""
QUIT
+4 IF $PIECE(^DIC(16,Y,0),U)'=$PIECE(^VA(200,X,0),U)
WRITE !,Y," ",X
+5 QUIT
End DoDot:1
+6 QUIT
CHECK ;
+1 NEW VFP,TXP,NEW,DA,DIE,APCDX,VF
+2 WRITE !,"hang on...checking..."
+3 SET APCDX=0
FOR
SET APCDX=$ORDER(^BLRTXLOG(APCDX))
IF APCDX'=+APCDX
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^BLRTXLOG(APCDX,1)),U,3)<3021001
QUIT
+5 IF $PIECE(^BLRTXLOG(APCDX,1),U,4)'=9000010.09
QUIT
+6 SET VF=$PIECE(^BLRTXLOG(APCDX,1),U,5)
+7 IF VF=""
QUIT
+8 IF '$DATA(^AUPNVLAB(VF,12))
QUIT
+9 IF '$DATA(^AUPNVLAB(VF,0))
QUIT
+10 SET VFP=$$VAL^XBDIQ1(9000010.09,VF,1202)
+11 SET TXP=$$VAL^XBDIQ1(9009022,APCDX,1104)
+12 ;a match
IF VFP=TXP
QUIT
+13 IF $PIECE(VFP,",")=$PIECE(TXP,",")
QUIT
+14 ;I VFP'=TXP W !,"does not match: VF=",VF," TX=",APCDX," ",VFP," ",TXP
+15 SET NEW=$PIECE(^BLRTXLOG(APCDX,11),U,4)
SET NEW=$PIECE(^VA(200,NEW,0),U,16)
+16 IF NEW=""
QUIT
+17 SET DA=VF
SET DIE="^AUPNVLAB("
SET DR="1202///`"_NEW
DO ^DIE
DO ^XBFMK
+18 QUIT
End DoDot:1
+19 WRITE !,"all done"
+20 QUIT
