APCDRV.m

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