APCDRV ; IHS/CMI/LAB - REVIEW A VISIT ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;
;IHS/CMI/LAB - patch 1 for file 200 converted sites
START ;
Q:'$D(APCDVSIT)
Q:APCDVSIT=""
K APCDTALK,APCDERR
I $D(AUPNTALK) S APCDTALK=""
S:'$D(AUPNTALK) AUPNTALK=""
S APCDEC=1,APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT
I '$D(^AUPNVSIT(APCDVSIT,0)) S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E127" D ERR Q
S APCDVREC=^AUPNVSIT(APCDVSIT,0)
Q:$P(APCDVREC,U,11)
D ZERO
I $D(APCDERR) G EOJ
D ^APCDR00
D CHKV
D CHKCHA ;PER PETERSON ON 11/13/09
K APCDRV
D:$P(APCDVREC,U,7)="H" ^APCDRVH
EOJ ;
I '$D(APCDTALK) K AUPNTALK,APCDTALK
K APCDVFLE,APCDVNM,APCDVDG,APCDVIGR,APCDTALK,APCDE,APCDCLN,APCDEC,APCDPPRV,APCDVREC,APCDLDFN,APCDPCOD,APCDPDIS,APCDPAFF,APCDEDFN
K X,Y
K AUPNPAT,AUPNDAYS,AUPNSEX,AUPNDOD,AUPNDOB
Q
ERR ; EP;PROCESS ERROR
Q:$D(APCDERR("B",APCDE("FILE"),APCDE("ENTRY"),APCDE))
S APCDERR(APCDEC)=$O(^APCDERR("B",APCDE,"")),APCDERR(APCDEC,"FILE")=APCDE("FILE"),APCDERR(APCDEC,"ENTRY")=APCDE("ENTRY")
S APCDERR("B",APCDERR(APCDEC,"FILE"),APCDERR(APCDEC,"ENTRY"),APCDE)="",APCDEC=APCDEC+1
Q
ZERO ;EP;check for dependent entries, if none, save information
S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT
I '$P(^AUPNVSIT(APCDVSIT,0),U,9) S APCDE("FILE")=9000010,APCDE("ENTRY")=APCDVSIT,APCDE="E100" D ERR
Q
CHKV ;
S X2=AUPNDOB,X1=$P($P(APCDVREC,U),".") D ^%DTC S AUPNDAYS=X
S APCDVFLE=9000010 F S APCDVFLE=$O(^DIC(APCDVFLE)) Q:APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE) D CHKV2
Q
;
CHKV2 ;
S APCDVNM=$P(^DIC(APCDVFLE,0),U),APCDVDG=^DIC(APCDVFLE,0,"GL"),APCDVIGR=APCDVDG_"""AD"",APCDVSIT,APCDEDFN)"
S APCDEDFN="" F S APCDEDFN=$O(@APCDVIGR) Q:APCDEDFN="" D CHKV3
Q
;
CHKV3 ;
S X="APCDR"_$P(APCDVFLE,".",2) X ^%ZOSF("TEST") Q:'$T
S X="^"_X
D @(X)
Q
;
CHKCHA ;
Q:'$P($G(^APCDSITE(DUZ(2),0)),U,35)
CHA ;
Q:DUZ("AG")'="I"
Q:$P(^APCPSITE(1,0),U,9)'="Y"
Q:"ETC"[$P(APCDVREC,U,7)
Q:"V"[$P(APCDVREC,U,3)
Q:'$D(^AUPNVPRV("AD",APCDVSIT))
Q:'$D(^AUPNVPOV("AD",APCDVSIT))
S APCDRV("CHA")=0
S (APCDRV(1),APCDRV(2))=0
F S APCDRV(2)=$O(^AUPNVPRV("AD",APCDVSIT,APCDRV(2))) Q:APCDRV(2)="" D DISC
;check secondary providers
CHA2 ;
Q:APCDRV("CHA")=0
I '$D(^AUPNVTM("AD",APCDVSIT)) S APCDE="E054",APCDE("ENTRY")=APCDVSIT,APCDE("FILE")=9000010 D ERR Q
K APCDRV
Q
DISC ;
I $P(^DD(9000010.06,.01,0),U,2)[200 D DISC200 Q
S APCDRV("AP")=$P(^AUPNVPRV(APCDRV(2),0),U,1),APCDRV("DISC")=""
Q:'$D(^DIC(6,APCDRV("AP")))
S APCDRV("Y")=$P(^DIC(6,APCDRV("AP"),0),U,4)
Q:APCDRV("Y")=""
Q:'$D(^DIC(7,APCDRV("Y"),9999999))
S APCDRV("CHA DISC")=$P(^DIC(7,APCDRV("Y"),9999999),U,1) I APCDRV("CHA DISC")="" Q
Q:APCDRV("CHA DISC")'=13&(APCDRV("CHA DISC")'=32)
S APCDRV("CHA")=APCDRV("CHA")+1
;
Q
DISC200 ;IHS/CMI/LAB - patch 1 for file 200 converted sites
S APCDRV("AP")=$P(^AUPNVPRV(APCDRV(2),0),U,1)
Q:'APCDRV("AP")
S APCDRV("CHA DISC")=$$PROVCLSC^XBFUNC1(APCDRV("AP"))
Q:APCDRV("CHA DISC")'=13&(APCDRV("CHA DISC")'=32)
S APCDRV("CHA")=APCDRV("CHA")+1
;
Q
APCDRV ; IHS/CMI/LAB - REVIEW A VISIT ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;
+3 ;IHS/CMI/LAB - patch 1 for file 200 converted sites
START ;
+1 IF '$DATA(APCDVSIT)
QUIT
+2 IF APCDVSIT=""
QUIT
+3 KILL APCDTALK,APCDERR
+4 IF $DATA(AUPNTALK)
SET APCDTALK=""
+5 IF '$DATA(AUPNTALK)
SET AUPNTALK=""
+6 SET APCDEC=1
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
+7 IF '$DATA(^AUPNVSIT(APCDVSIT,0))
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E127"
DO ERR
QUIT
+8 SET APCDVREC=^AUPNVSIT(APCDVSIT,0)
+9 IF $PIECE(APCDVREC,U,11)
QUIT
+10 DO ZERO
+11 IF $DATA(APCDERR)
GOTO EOJ
+12 DO ^APCDR00
+13 DO CHKV
+14 ;PER PETERSON ON 11/13/09
DO CHKCHA
+15 KILL APCDRV
+16 IF $PIECE(APCDVREC,U,7)="H"
DO ^APCDRVH
EOJ ;
+1 IF '$DATA(APCDTALK)
KILL AUPNTALK,APCDTALK
+2 KILL APCDVFLE,APCDVNM,APCDVDG,APCDVIGR,APCDTALK,APCDE,APCDCLN,APCDEC,APCDPPRV,APCDVREC,APCDLDFN,APCDPCOD,APCDPDIS,APCDPAFF,APCDEDFN
+3 KILL X,Y
+4 KILL AUPNPAT,AUPNDAYS,AUPNSEX,AUPNDOD,AUPNDOB
+5 QUIT
ERR ; EP;PROCESS ERROR
+1 IF $DATA(APCDERR("B",APCDE("FILE"),APCDE("ENTRY"),APCDE))
QUIT
+2 SET APCDERR(APCDEC)=$ORDER(^APCDERR("B",APCDE,""))
SET APCDERR(APCDEC,"FILE")=APCDE("FILE")
SET APCDERR(APCDEC,"ENTRY")=APCDE("ENTRY")
+3 SET APCDERR("B",APCDERR(APCDEC,"FILE"),APCDERR(APCDEC,"ENTRY"),APCDE)=""
SET APCDEC=APCDEC+1
+4 QUIT
ZERO ;EP;check for dependent entries, if none, save information
+1 SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
+2 IF '$PIECE(^AUPNVSIT(APCDVSIT,0),U,9)
SET APCDE("FILE")=9000010
SET APCDE("ENTRY")=APCDVSIT
SET APCDE="E100"
DO ERR
+3 QUIT
CHKV ;
+1 SET X2=AUPNDOB
SET X1=$PIECE($PIECE(APCDVREC,U),".")
DO ^%DTC
SET AUPNDAYS=X
+2 SET APCDVFLE=9000010
FOR
SET APCDVFLE=$ORDER(^DIC(APCDVFLE))
IF APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)
QUIT
DO CHKV2
+3 QUIT
+4 ;
CHKV2 ;
+1 SET APCDVNM=$PIECE(^DIC(APCDVFLE,0),U)
SET APCDVDG=^DIC(APCDVFLE,0,"GL")
SET APCDVIGR=APCDVDG_"""AD"",APCDVSIT,APCDEDFN)"
+2 SET APCDEDFN=""
FOR
SET APCDEDFN=$ORDER(@APCDVIGR)
IF APCDEDFN=""
QUIT
DO CHKV3
+3 QUIT
+4 ;
CHKV3 ;
+1 SET X="APCDR"_$PIECE(APCDVFLE,".",2)
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT
+2 SET X="^"_X
+3 DO @(X)
+4 QUIT
+5 ;
CHKCHA ;
+1 IF '$PIECE($GET(^APCDSITE(DUZ(2),0)),U,35)
QUIT
CHA ;
+1 IF DUZ("AG")'="I"
QUIT
+2 IF $PIECE(^APCPSITE(1,0),U,9)'="Y"
QUIT
+3 IF "ETC"[$PIECE(APCDVREC,U,7)
QUIT
+4 IF "V"[$PIECE(APCDVREC,U,3)
QUIT
+5 IF '$DATA(^AUPNVPRV("AD",APCDVSIT))
QUIT
+6 IF '$DATA(^AUPNVPOV("AD",APCDVSIT))
QUIT
+7 SET APCDRV("CHA")=0
+8 SET (APCDRV(1),APCDRV(2))=0
+9 FOR
SET APCDRV(2)=$ORDER(^AUPNVPRV("AD",APCDVSIT,APCDRV(2)))
IF APCDRV(2)=""
QUIT
DO DISC
+10 ;check secondary providers
CHA2 ;
+1 IF APCDRV("CHA")=0
QUIT
+2 IF '$DATA(^AUPNVTM("AD",APCDVSIT))
SET APCDE="E054"
SET APCDE("ENTRY")=APCDVSIT
SET APCDE("FILE")=9000010
DO ERR
QUIT
+3 KILL APCDRV
+4 QUIT
DISC ;
+1 IF $PIECE(^DD(9000010.06,.01,0),U,2)[200
DO DISC200
QUIT
+2 SET APCDRV("AP")=$PIECE(^AUPNVPRV(APCDRV(2),0),U,1)
SET APCDRV("DISC")=""
+3 IF '$DATA(^DIC(6,APCDRV("AP")))
QUIT
+4 SET APCDRV("Y")=$PIECE(^DIC(6,APCDRV("AP"),0),U,4)
+5 IF APCDRV("Y")=""
QUIT
+6 IF '$DATA(^DIC(7,APCDRV("Y"),9999999))
QUIT
+7 SET APCDRV("CHA DISC")=$PIECE(^DIC(7,APCDRV("Y"),9999999),U,1)
IF APCDRV("CHA DISC")=""
QUIT
+8 IF APCDRV("CHA DISC")'=13&(APCDRV("CHA DISC")'=32)
QUIT
+9 SET APCDRV("CHA")=APCDRV("CHA")+1
+10 ;
+11 QUIT
DISC200 ;IHS/CMI/LAB - patch 1 for file 200 converted sites
+1 SET APCDRV("AP")=$PIECE(^AUPNVPRV(APCDRV(2),0),U,1)
+2 IF 'APCDRV("AP")
QUIT
+3 SET APCDRV("CHA DISC")=$$PROVCLSC^XBFUNC1(APCDRV("AP"))
+4 IF APCDRV("CHA DISC")'=13&(APCDRV("CHA DISC")'=32)
QUIT
+5 SET APCDRV("CHA")=APCDRV("CHA")+1
+6 ;
+7 QUIT
