- APCLPN1 ; IHS/CMI/LAB - PROVIDER NARRATIVE LISTING ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- START ;
- S APCLBT=$H
- K ^XTMP("APCLPN",APCLJOB,APCLBTH)
- D XTMP^APCLOSUT("APCLPN","PCC PROV NARR REVIEW")
- V ; Run by visit date
- S APCLODAT=APCLSD_".9999" F S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED) D V1
- ;
- END ;
- S APCLET=$H
- Q
- V1 ;
- S V="" F S V=$O(^AUPNVSIT("B",APCLODAT,V)) Q:V'=+V I $D(^AUPNVSIT(V,0)) S APCLVREC=^(0) D
- .K APCLSKIP
- .Q:'$P(APCLVREC,U,9)
- .Q:$P(APCLVREC,U,11)
- .Q:'$D(^AUPNVPOV("AD",V))
- .Q:'$D(^AUPNVPRV("AD",V))
- .S B=0 F S B=$O(^AUPNVPRV("AD",V,B)) Q:B="" D
- ..I APCLPRIM,$P(^AUPNVPRV(B,0),U,4)'="P" Q
- ..S P=$P(^AUPNVPRV(B,0),U)
- ..S F=0
- ..D @APCLPSRT
- ..Q:'F
- ..S ^XTMP("APCLPN",APCLJOB,APCLBTH,S,V)=""
- ..Q
- .Q
- Q
- ;
- P ;
- I $D(APCLCDIS) S S="" D D Q:S=""
- S S=P,F=1
- Q
- ;
- O ;
- Q:APCLPROV'=P
- S S=P,F=1
- Q
- ;
- D ;
- Q:'$D(^DIC(6,P))
- S Y=$P(^DIC(6,P,0),U,4)
- Q:Y=""
- Q:APCLDISC'=Y
- S S=APCLDISC
- S F=1
- Q
- ;
- A ;
- Q:'$D(^DIC(6,P))
- S Y=$P(^DIC(6,P,0),U,4)
- Q:Y=""
- S S=Y
- S F=1
- Q
- ;
- APCLPN1 ; IHS/CMI/LAB - PROVIDER NARRATIVE LISTING ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- START ;
- +1 SET APCLBT=$HOROLOG
- +2 KILL ^XTMP("APCLPN",APCLJOB,APCLBTH)
- +3 DO XTMP^APCLOSUT("APCLPN","PCC PROV NARR REVIEW")
- V ; Run by visit date
- +1 SET APCLODAT=APCLSD_".9999"
- FOR
- SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLODAT))
- IF APCLODAT=""!((APCLODAT\1)>APCLED)
- QUIT
- DO V1
- +2 ;
- END ;
- +1 SET APCLET=$HOROLOG
- +2 QUIT
- V1 ;
- +1 SET V=""
- FOR
- SET V=$ORDER(^AUPNVSIT("B",APCLODAT,V))
- IF V'=+V
- QUIT
- IF $DATA(^AUPNVSIT(V,0))
- SET APCLVREC=^(0)
- Begin DoDot:1
- +2 KILL APCLSKIP
- +3 IF '$PIECE(APCLVREC,U,9)
- QUIT
- +4 IF $PIECE(APCLVREC,U,11)
- QUIT
- +5 IF '$DATA(^AUPNVPOV("AD",V))
- QUIT
- +6 IF '$DATA(^AUPNVPRV("AD",V))
- QUIT
- +7 SET B=0
- FOR
- SET B=$ORDER(^AUPNVPRV("AD",V,B))
- IF B=""
- QUIT
- Begin DoDot:2
- +8 IF APCLPRIM
- IF $PIECE(^AUPNVPRV(B,0),U,4)'="P"
- QUIT
- +9 SET P=$PIECE(^AUPNVPRV(B,0),U)
- +10 SET F=0
- +11 DO @APCLPSRT
- +12 IF 'F
- QUIT
- +13 SET ^XTMP("APCLPN",APCLJOB,APCLBTH,S,V)=""
- +14 QUIT
- End DoDot:2
- +15 QUIT
- End DoDot:1
- +16 QUIT
- +17 ;
- P ;
- +1 IF $DATA(APCLCDIS)
- SET S=""
- DO D
- IF S=""
- QUIT
- +2 SET S=P
- SET F=1
- +3 QUIT
- +4 ;
- O ;
- +1 IF APCLPROV'=P
- QUIT
- +2 SET S=P
- SET F=1
- +3 QUIT
- +4 ;
- D ;
- +1 IF '$DATA(^DIC(6,P))
- QUIT
- +2 SET Y=$PIECE(^DIC(6,P,0),U,4)
- +3 IF Y=""
- QUIT
- +4 IF APCLDISC'=Y
- QUIT
- +5 SET S=APCLDISC
- +6 SET F=1
- +7 QUIT
- +8 ;
- A ;
- +1 IF '$DATA(^DIC(6,P))
- QUIT
- +2 SET Y=$PIECE(^DIC(6,P,0),U,4)
- +3 IF Y=""
- QUIT
- +4 SET S=Y
- +5 SET F=1
- +6 QUIT
- +7 ;
