BEHUPCCK.m

BEHUPCCK ;MSC/IND/DKM - Verifies that visit patient matches V file entries ;04-May-2006 08:19;DKM

 ;;1.2;BEH UTILITIES;;Mar 20, 2007

 ;=================================================================

 N DAT,DFN,IEN,X,VFIL,GBL,PCC,CNT,TOT,FLG,XRF

 W !!,"Lists V file entries whose patient does not match parent visit.",!!

 W "Output format is:",!

 W ?5,"VISIT IEN,VFIL,VFIL IEN,VISIT DFN,VFIL DFN",!!

 S CNT=0,TOT=0,XRF="B"  ; OR "APCIS"

 S %DT="AE",%DT("A")="Search all visits on or after: "

 D ^%DT

 Q:Y<1

 D ^%ZIS

 Q:POP

 W !!

 U IO

 F DAT=Y:0 D  S DAT=$O(^AUPNVSIT(XRF,DAT)) Q:'DAT

 .F IEN=0:0 S IEN=$O(^AUPNVSIT(XRF,DAT,IEN)) Q:'IEN  D

 ..S X=^AUPNVSIT(IEN,0),DFN=$P(X,U,5),FLG=0

 ..F VFIL=9000010:0 S VFIL=$O(^DIC(VFIL)) Q:VFIL\1'=9000010  D

 ...S GBL=$$ROOT^DILFD(VFIL,,1),VFIL(0)=$P(@GBL@(0),U)

 ...F PCC=0:0 S PCC=$O(@GBL@("AD",IEN,PCC)) Q:'PCC  D

 ....S X=@GBL@(PCC,0)

 ....Q:$P(X,U,2)=DFN

 ....W IEN,U,VFIL(0),U,PCC,U,$$PATNAM(DFN),U,$$PATNAM($P(X,U,2)),!

 ....S TOT=TOT+1

 ....S:'FLG CNT=CNT+1,FLG=1

 W !!,"Visits: ",CNT,!,"Total: ",TOT,!!

 R:$E(IOST,1,2)="C-" !!,"Press ENTER to continue...",X:DTIME,!

 D ^%ZISC

 Q

PATNAM(DFN) Q $P($G(^DPT(+DFN,0),"Unknown"),U)

BEHUPCCK  ;MSC/IND/DKM - Verifies that visit patient matches V file entries ;04-May-2006 08:19;DKM

 +1       ;;1.2;BEH UTILITIES;;Mar 20, 2007

 +2       ;=================================================================

 +3        NEW DAT,DFN,IEN,X,VFIL,GBL,PCC,CNT,TOT,FLG,XRF

 +4        WRITE !!,"Lists V file entries whose patient does not match parent visit.",!!

 +5        WRITE "Output format is:",!

 +6        WRITE ?5,"VISIT IEN,VFIL,VFIL IEN,VISIT DFN,VFIL DFN",!!

 +7       ; OR "APCIS"

           SET CNT=0

           SET TOT=0

           SET XRF="B"

 +8        SET %DT="AE"

           SET %DT("A")="Search all visits on or after: "

 +9        DO ^%DT

 +10       IF Y<1

               QUIT 

 +11       DO ^%ZIS

 +12       IF POP

               QUIT 

 +13       WRITE !!

 +14       USE IO

 +15       FOR DAT=Y:0

               Begin DoDot:1

 +16               FOR IEN=0:0

                       SET IEN=$ORDER(^AUPNVSIT(XRF,DAT,IEN))

                       IF 'IEN

                           QUIT 

                       Begin DoDot:2

 +17                       SET X=^AUPNVSIT(IEN,0)

                           SET DFN=$PIECE(X,U,5)

                           SET FLG=0

 +18                       FOR VFIL=9000010:0

                               SET VFIL=$ORDER(^DIC(VFIL))

                               IF VFIL\1'=9000010

                                   QUIT 

                               Begin DoDot:3

 +19                               SET GBL=$$ROOT^DILFD(VFIL,,1)

                                   SET VFIL(0)=$PIECE(@GBL@(0),U)

 +20                               FOR PCC=0:0

                                       SET PCC=$ORDER(@GBL@("AD",IEN,PCC))

                                       IF 'PCC

                                           QUIT 

                                       Begin DoDot:4

 +21                                       SET X=@GBL@(PCC,0)

 +22                                       IF $PIECE(X,U,2)=DFN

                                               QUIT 

 +23                                       WRITE IEN,U,VFIL(0),U,PCC,U,$$PATNAM(DFN),U,$$PATNAM($PIECE(X,U,2)),!

 +24                                       SET TOT=TOT+1

 +25                                       IF 'FLG

                                               SET CNT=CNT+1

                                               SET FLG=1

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

               SET DAT=$ORDER(^AUPNVSIT(XRF,DAT))

               IF 'DAT

                   QUIT 

 +26       WRITE !!,"Visits: ",CNT,!,"Total: ",TOT,!!

 +27       IF $EXTRACT(IOST,1,2)="C-"

               READ !!,"Press ENTER to continue...",X:DTIME,!

 +28       DO ^%ZISC

 +29       QUIT 

PATNAM(DFN)  QUIT $PIECE($GET(^DPT(+DFN,0),"Unknown"),U)