- 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
