- 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
