APCLRPL1 ; IHS/CMI/LAB - PROCESS R-DMG-510 ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
START ;
S (APCLBT,APCLBTH)=$H,APCLJOB=$J,APCLRCNT=0,APCLPTCT=0
D XTMP^APCLOSUT("APCLRPL","PCC - DMG PAT LISTING")
D PP,END
Q
;
;
PP ;
S DFN=0 F S DFN=$O(^DPT(DFN)) Q:DFN'=+DFN I '$P(^DPT(DFN,0),U,19) D PROC
Q
;
END ;
S APCLET=$H
Q
PROC ;
Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))
K APCLSPEC
D SCREENS
Q:$D(APCLSKIP)
K APCLSRT,APCLPRNT S APCLCRIT=APCLSORT,APCLX=0
X:$D(^APCLVSTS(APCLSORT,4)) ^APCLVSTS(APCLSORT,4) I '$D(APCLPRNT) D
. I APCLPTVS="V" S Y=$P($P(APCLVREC,U),".") S APCLPRNT=Y Q
. S APCLPRNT=$P(^DPT(DFN,0),U)
.Q
S APCLSRT=APCLPRNT
S ^XTMP("APCLRPL",APCLJOB,APCLBTH,"DATA HITS",APCLSRT,DFN)="",APCLRCNT=APCLRCNT+1
Q:$D(^XTMP("APCLRPL",APCLJOB,APCLBTH,"PATIENTS",DFN))!($D(APCLSCNT))
S ^XTMP("APCLRPL",APCLJOB,APCLBTH,"PATIENTS",DFN)="",APCLPTCT=APCLPTCT+1
Q
SCREENS ;
K APCLSKIP
S APCLI=0 F S APCLI=$O(^APCLVRPT(APCLRPT,11,APCLI)) Q:APCLI'=+APCLI!($D(APCLSKIP)) D
.I '$P(^APCLVSTS(APCLI,0),U,8) D SINGLE Q
.D MULT
.Q
Q
SINGLE ;
K X,APCLSPEC S X="",APCLX=0
X:$D(^APCLVSTS(APCLI,1)) ^(1)
I X="" S APCLSKIP="" Q
I '$D(APCLSPEC),'$D(^APCLVRPT(APCLRPT,11,APCLI,11,"B",X)) S APCLSKIP="" Q
Q
MULT ;
K APCLFOUN,APCLSKIP,APCLSPEC,X S APCLX=0,X=""
X:$D(^APCLVSTS(APCLI,1)) ^(1)
I $O(X(""))="" S APCLSKIP="" Q
I '$D(APCLSPEC) S Y="" F S Y=$O(X(Y)) Q:Y="" I $D(^APCLVRPT(APCLRPT,11,APCLI,11,"B",Y)) S APCLFOUN="" Q
I $D(APCLSPEC),$G(X) S APCLFOUN=1 Q
S:'$D(APCLFOUN) APCLSKIP=""
Q
APCLRPL1 ; IHS/CMI/LAB - PROCESS R-DMG-510 ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;
START ;
+1 SET (APCLBT,APCLBTH)=$HOROLOG
SET APCLJOB=$JOB
SET APCLRCNT=0
SET APCLPTCT=0
+2 DO XTMP^APCLOSUT("APCLRPL","PCC - DMG PAT LISTING")
+3 DO PP
DO END
+4 QUIT
+5 ;
+6 ;
PP ;
+1 SET DFN=0
FOR
SET DFN=$ORDER(^DPT(DFN))
IF DFN'=+DFN
QUIT
IF '$PIECE(^DPT(DFN,0),U,19)
DO PROC
+2 QUIT
+3 ;
END ;
+1 SET APCLET=$HOROLOG
+2 QUIT
PROC ;
+1 IF $$DEMO^APCLUTL(DFN,$GET(APCLDEMO))
QUIT
+2 KILL APCLSPEC
+3 DO SCREENS
+4 IF $DATA(APCLSKIP)
QUIT
+5 KILL APCLSRT,APCLPRNT
SET APCLCRIT=APCLSORT
SET APCLX=0
+6 IF $DATA(^APCLVSTS(APCLSORT,4))
XECUTE ^APCLVSTS(APCLSORT,4)
IF '$DATA(APCLPRNT)
Begin DoDot:1
+7 IF APCLPTVS="V"
SET Y=$PIECE($PIECE(APCLVREC,U),".")
SET APCLPRNT=Y
QUIT
+8 SET APCLPRNT=$PIECE(^DPT(DFN,0),U)
+9 QUIT
End DoDot:1
+10 SET APCLSRT=APCLPRNT
+11 SET ^XTMP("APCLRPL",APCLJOB,APCLBTH,"DATA HITS",APCLSRT,DFN)=""
SET APCLRCNT=APCLRCNT+1
+12 IF $DATA(^XTMP("APCLRPL",APCLJOB,APCLBTH,"PATIENTS",DFN))!($DATA(APCLSCNT))
QUIT
+13 SET ^XTMP("APCLRPL",APCLJOB,APCLBTH,"PATIENTS",DFN)=""
SET APCLPTCT=APCLPTCT+1
+14 QUIT
SCREENS ;
+1 KILL APCLSKIP
+2 SET APCLI=0
FOR
SET APCLI=$ORDER(^APCLVRPT(APCLRPT,11,APCLI))
IF APCLI'=+APCLI!($DATA(APCLSKIP))
QUIT
Begin DoDot:1
+3 IF '$PIECE(^APCLVSTS(APCLI,0),U,8)
DO SINGLE
QUIT
+4 DO MULT
+5 QUIT
End DoDot:1
+6 QUIT
SINGLE ;
+1 KILL X,APCLSPEC
SET X=""
SET APCLX=0
+2 IF $DATA(^APCLVSTS(APCLI,1))
XECUTE ^(1)
+3 IF X=""
SET APCLSKIP=""
QUIT
+4 IF '$DATA(APCLSPEC)
IF '$DATA(^APCLVRPT(APCLRPT,11,APCLI,11,"B",X))
SET APCLSKIP=""
QUIT
+5 QUIT
MULT ;
+1 KILL APCLFOUN,APCLSKIP,APCLSPEC,X
SET APCLX=0
SET X=""
+2 IF $DATA(^APCLVSTS(APCLI,1))
XECUTE ^(1)
+3 IF $ORDER(X(""))=""
SET APCLSKIP=""
QUIT
+4 IF '$DATA(APCLSPEC)
SET Y=""
FOR
SET Y=$ORDER(X(Y))
IF Y=""
QUIT
IF $DATA(^APCLVRPT(APCLRPT,11,APCLI,11,"B",Y))
SET APCLFOUN=""
QUIT
+5 IF $DATA(APCLSPEC)
IF $GET(X)
SET APCLFOUN=1
QUIT
+6 IF '$DATA(APCLFOUN)
SET APCLSKIP=""
+7 QUIT
