APCLAUD1 ; IHS/CMI/LAB - more audit report ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;PRINT AUDIT SEARCH PCC VISITS
START ;
S APCL80D="--------------------------------------------------------------------------------" ;80 DASHES
S Y=APCLBD X ^DD("DD") S APCLBDY=Y S Y=APCLED X ^DD("DD") S APCLEDY=Y S Y=DT X ^DD("DD") S APCLDTP=Y
SITE S APCLSITE=DUZ(2)
S (APCLPG,APCLCNT)=0
I $D(^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV","ALL")) S APCLALLP=""
I $D(^XTMP("APCLAUD",APCLJOB,APCLBT,"ICDDFN","ALL")) S APCLALLI=""
I $D(^XTMP("APCLAUD",APCLJOB,APCLBT,"RAND","ALL")) S APCLALLR=""
I $D(^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV","NOSORT")) S (APCLNOSP,APCLALLP)=""
S APCLLIM=$O(^XTMP("APCLAUD",APCLJOB,APCLBT,"RAND",""))
S APCLS=APCLBD-.0001
F I=0:0 S APCLS=$O(^AUPNVSIT("B",APCLS)) Q:APCLS=""!(APCLS>(APCLED+.2359)) D C1
S APCLET=$H G DONE
C1 S APCLVDFN=0 F J=0:0 S APCLVDFN=$O(^AUPNVSIT("B",APCLS,APCLVDFN)) Q:APCLVDFN="" D C2
Q
C2 Q:'$D(^AUPNVSIT(APCLVDFN,0))
S APCLVN0=^AUPNVSIT(APCLVDFN,0)
S APCLPNUM=$P(APCLVN0,U,5)
Q:$$DEMO^APCLUTL(APCLPNUM,$G(APCLDEMO))
I $D(APCLSC),APCLSC'=$P(APCLVN0,U,7) Q
Q:$P(APCLVN0,"^",11)
I $D(APCLTYPE),$P(APCLVN0,U,3)'=APCLTYPE Q
I $D(APCLCLN),APCLCLN'=$P(APCLVN0,U,8) Q
I $D(APCLLOC),APCLLOC'=$P(APCLVN0,U,6) Q
I $D(APCLSEX),APCLSEX'=$P(^DPT(APCLPNUM,0),U,2) Q
G:'$D(APCLLAG) PRVCK
S APCLPDYS=$S($D(^DPT($P(APCLVN0,"^",5),0)):$P(^(0),"^",3),1:"") Q:APCLPDYS="" S X1=$P(APCLS,"."),X2=APCLPDYS D ^%DTC S APCLPDYS=X
Q:APCLPDYS<APCLLAG Q:APCLPDYS>APCLHAG
PRVCK S APCLPDFN="" F K=0:0 S APCLPDFN=$O(^AUPNVPRV("AD",APCLVDFN,APCLPDFN)) Q:APCLPDFN="" D P1
Q
P1 Q:'$D(^AUPNVPRV(APCLPDFN,0))
S APCLPN0=^AUPNVPRV(APCLPDFN,0),APCLPNO=+APCLPN0,APCLPPR=$P(APCLPN0,"^",4),APCLPNO1=APCLPNO
Q:APCLPPR'="P"
G:$D(APCLALLP) ICDCK
Q:'$D(^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV",APCLPNO))
ICDCK S APCLIDFN="" F S APCLIDFN=$O(^AUPNVPOV("AD",APCLVDFN,APCLIDFN)) Q:APCLIDFN="" D I1
Q
I1 Q:'$D(^AUPNVPOV(APCLIDFN,0))
S APCLINO=+^AUPNVPOV(APCLIDFN,0)
I $D(APCLALLI) S APCLIRNG=0 G I11
Q:'$D(^XTMP("APCLAUD",APCLJOB,APCLBT,"ICDDFN",APCLINO))
S APCLIRNG=$O(^XTMP("APCLAUD",APCLJOB,APCLBT,"ICDDFN",APCLINO,""))
I11 S:$D(APCLNOSP) APCLPNO="ALL"
S ^XTMP("APCLAUD2",APCLJOB,APCLBT,APCLPNO,APCLIRNG,APCLINO,APCLVDFN)=APCLPNO1_U_APCLIDFN
Q:$D(APCLALLR)
S ^XTMP("APCLAUD2",APCLJOB,APCLBT,APCLPNO,APCLIRNG,0)=$S($D(^XTMP("APCLAUD2",APCLJOB,APCLBT,APCLPNO,APCLIRNG,0)):^(0)+1,1:1)
Q
DONE Q
APCLAUD1 ; IHS/CMI/LAB - more audit report ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;PRINT AUDIT SEARCH PCC VISITS
START ;
+1 ;80 DASHES
SET APCL80D="--------------------------------------------------------------------------------"
+2 SET Y=APCLBD
XECUTE ^DD("DD")
SET APCLBDY=Y
SET Y=APCLED
XECUTE ^DD("DD")
SET APCLEDY=Y
SET Y=DT
XECUTE ^DD("DD")
SET APCLDTP=Y
SITE SET APCLSITE=DUZ(2)
+1 SET (APCLPG,APCLCNT)=0
+2 IF $DATA(^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV","ALL"))
SET APCLALLP=""
+3 IF $DATA(^XTMP("APCLAUD",APCLJOB,APCLBT,"ICDDFN","ALL"))
SET APCLALLI=""
+4 IF $DATA(^XTMP("APCLAUD",APCLJOB,APCLBT,"RAND","ALL"))
SET APCLALLR=""
+5 IF $DATA(^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV","NOSORT"))
SET (APCLNOSP,APCLALLP)=""
+6 SET APCLLIM=$ORDER(^XTMP("APCLAUD",APCLJOB,APCLBT,"RAND",""))
+7 SET APCLS=APCLBD-.0001
+8 FOR I=0:0
SET APCLS=$ORDER(^AUPNVSIT("B",APCLS))
IF APCLS=""!(APCLS>(APCLED+.2359))
QUIT
DO C1
+9 SET APCLET=$HOROLOG
GOTO DONE
C1 SET APCLVDFN=0
FOR J=0:0
SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLS,APCLVDFN))
IF APCLVDFN=""
QUIT
DO C2
+1 QUIT
C2 IF '$DATA(^AUPNVSIT(APCLVDFN,0))
QUIT
+1 SET APCLVN0=^AUPNVSIT(APCLVDFN,0)
+2 SET APCLPNUM=$PIECE(APCLVN0,U,5)
+3 IF $$DEMO^APCLUTL(APCLPNUM,$GET(APCLDEMO))
QUIT
+4 IF $DATA(APCLSC)
IF APCLSC'=$PIECE(APCLVN0,U,7)
QUIT
+5 IF $PIECE(APCLVN0,"^",11)
QUIT
+6 IF $DATA(APCLTYPE)
IF $PIECE(APCLVN0,U,3)'=APCLTYPE
QUIT
+7 IF $DATA(APCLCLN)
IF APCLCLN'=$PIECE(APCLVN0,U,8)
QUIT
+8 IF $DATA(APCLLOC)
IF APCLLOC'=$PIECE(APCLVN0,U,6)
QUIT
+9 IF $DATA(APCLSEX)
IF APCLSEX'=$PIECE(^DPT(APCLPNUM,0),U,2)
QUIT
+10 IF '$DATA(APCLLAG)
GOTO PRVCK
+11 SET APCLPDYS=$SELECT($DATA(^DPT($PIECE(APCLVN0,"^",5),0)):$PIECE(^(0),"^",3),1:"")
IF APCLPDYS=""
QUIT
SET X1=$PIECE(APCLS,".")
SET X2=APCLPDYS
DO ^%DTC
SET APCLPDYS=X
+12 IF APCLPDYS<APCLLAG
QUIT
IF APCLPDYS>APCLHAG
QUIT
PRVCK SET APCLPDFN=""
FOR K=0:0
SET APCLPDFN=$ORDER(^AUPNVPRV("AD",APCLVDFN,APCLPDFN))
IF APCLPDFN=""
QUIT
DO P1
+1 QUIT
P1 IF '$DATA(^AUPNVPRV(APCLPDFN,0))
QUIT
+1 SET APCLPN0=^AUPNVPRV(APCLPDFN,0)
SET APCLPNO=+APCLPN0
SET APCLPPR=$PIECE(APCLPN0,"^",4)
SET APCLPNO1=APCLPNO
+2 IF APCLPPR'="P"
QUIT
+3 IF $DATA(APCLALLP)
GOTO ICDCK
+4 IF '$DATA(^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV",APCLPNO))
QUIT
ICDCK SET APCLIDFN=""
FOR
SET APCLIDFN=$ORDER(^AUPNVPOV("AD",APCLVDFN,APCLIDFN))
IF APCLIDFN=""
QUIT
DO I1
+1 QUIT
I1 IF '$DATA(^AUPNVPOV(APCLIDFN,0))
QUIT
+1 SET APCLINO=+^AUPNVPOV(APCLIDFN,0)
+2 IF $DATA(APCLALLI)
SET APCLIRNG=0
GOTO I11
+3 IF '$DATA(^XTMP("APCLAUD",APCLJOB,APCLBT,"ICDDFN",APCLINO))
QUIT
+4 SET APCLIRNG=$ORDER(^XTMP("APCLAUD",APCLJOB,APCLBT,"ICDDFN",APCLINO,""))
I11 IF $DATA(APCLNOSP)
SET APCLPNO="ALL"
+1 SET ^XTMP("APCLAUD2",APCLJOB,APCLBT,APCLPNO,APCLIRNG,APCLINO,APCLVDFN)=APCLPNO1_U_APCLIDFN
+2 IF $DATA(APCLALLR)
QUIT
+3 SET ^XTMP("APCLAUD2",APCLJOB,APCLBT,APCLPNO,APCLIRNG,0)=$SELECT($DATA(^XTMP("APCLAUD2",APCLJOB,APCLBT,APCLPNO,APCLIRNG,0)):^(0)+1,1:1)
+4 QUIT
DONE QUIT
