APCDCAF2.m

APCDCAF2 ; IHS/CMI/LAB - MENTAL HLTH ROUTINE 16-AUG-1994 ;

 ;;2.0;IHS PCC SUITE;**2,7,8,11**;MAY 14, 2009;Build 58

 ;; ;

 ;

EN ; EP -- main entry point for CHART AUDIT LISTMANAGER DISPLAY

 S VALMCC=1

 NEW VALMCNT

 D TERM^VALM0

 D CLEAR^VALM1

 D EN^VALM("APCDCAF OP MAIN VIEW")

 D CLEAR^VALM1

 K ^TMP($J),^TMP("APCDCAF OP",$J)

 Q

 ;

HDR ;EP -- header code

 S X=" #",$E(X,6)="VISIT DATE",$E(X,21)="PATIENT NAME",$E(X,38)="HRN",$E(X,44)="FAC",$E(X,49)="HOSP LOC",$E(X,59)="S",$E(X,61)="CL",$E(X,64)="PRIM PROV",$E(X,75)="STATUS ERROR"

 S VALMHDR(2)=X

 S VALMHDR(1)="* an asterisk beside the visit number indicates the visit has an error"

 Q

 ;

INIT ;EP -- init variables and list array

 S VALMSG="Q - Quit/?? for more actions/+ next/- previous"

 D GATHER ;GATHER UP ALL VISITS FOR DISPLAY

 D RECDISP ;sort list by desired sort variable and set up listman display

 S VALMCNT=APCDRCNT

 Q

 ;

HELP ;EP -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 K APCDRCNT,^TMP($J,"APCDCAF OP"),^TMP($J)

 Q

 ;

EXPND ; -- expand code

 Q

 ;

GATHER ;

 K ^TMP($J),^TMP("APCDCAF OP",$J)

 S APCDODAT=9999999-APCDCAFD,APCDSTOP=9999999-APCDCAFD

 S (APCDRCNT,APCDVIEN)=0 F  S APCDODAT=$O(^AUPNVSIT("AA",APCDDFN,APCDODAT)) Q:APCDODAT=""!($P(APCDODAT,".")>APCDSTOP)  D

 .S APCDVIEN=0 F  S APCDVIEN=$O(^AUPNVSIT("AA",APCDDFN,APCDODAT,APCDVIEN)) Q:APCDVIEN'=+APCDVIEN  D

 ..S APCDV0=$G(^AUPNVSIT(APCDVIEN,0))

 ..Q:APCDV0=""

 ..Q:$P(APCDV0,U,11)        ;DELETED

 ..Q:$P(APCDV0,U,3)="C"     ;CONTRACT

 ..S APCDVLOC=$P(APCDV0,U,6)

 ..Q:APCDVLOC=""  ;no location of encounter

 ..S ^TMP($J,"APCDCAF OP",APCDVIEN,APCDVIEN)=""

 ..Q

 .Q

 Q

RECDISP ;

 S APCDSV="" F  S APCDSV=$O(^TMP($J,"APCDCAF OP",APCDSV)) Q:APCDSV=""  D

 .S APCDV=0 F  S APCDV=$O(^TMP($J,"APCDCAF OP",APCDSV,APCDV)) Q:APCDV'=+APCDV  D

 ..S APCDRCNT=APCDRCNT+1

 ..S APCDX="",DFN=$P(^AUPNVSIT(APCDV,0),U,5) D REC

 ..S ^TMP("APCDCAF OP",$J,APCDRCNT,0)=APCDX

 ..S ^TMP("APCDCAF OP",$J,"IDX",APCDRCNT,APCDRCNT)=APCDV

 K APCDV,APCDX,APCDSV

 Q

 ;

DATE(D) ;

 NEW X,Y

 S X=$P(D,".")

 S X=$E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)

 S Y=$$FMTE^XLFDT(D,"2S"),Y=$P(Y,"@",2),Y=$P(Y,":",1,2)

 Q X_"@"_Y

 ;

REC ;

 S APCDERR=$$ERRORCHK^APCDCAF(APCDV)

 S APCDX=""

 S APCDX=APCDRCNT_")"_$S(APCDERR]"":"*",1:"")

 S $E(APCDX,6)=$$DATE($P(^AUPNVSIT(APCDV,0),U))

 S $E(APCDX,21)=$E($P(^DPT(DFN,0),U),1,15)

 S $E(APCDX,37)=$$LBLK($$HRN^AUPNPAT(DFN,DUZ(2)),6)

 S L=$P(^AUPNVSIT(APCDV,0),U,6)

 S L=$P($G(^AUTTLOC(L,0)),U,7)

 S $E(APCDX,44)=L

 S $E(APCDX,49)=$E($$VAL^XBDIQ1(9000010,APCDV,.22),1,9)

 S $E(APCDX,59)=$P(^AUPNVSIT(APCDV,0),U,7)

 S $E(APCDX,61)=$$CLINIC^APCLV(APCDV,"C")

 S $E(APCDX,64)=$E($$PRIMPROV^APCLV(APCDV,"N"),1,10)

 S L=$P($G(^AUPNVSIT(APCDV,11)),U,11)

 S $E(APCDX,75)=L

 S $E(APCDX,77)=APCDERR

 Q

 ;

RBLK(V,L) ;left blank fill

 NEW %,I

 S %=$L(V),Z=L-% F I=1:1:Z S V=V_" "

 Q V

LBLK(V,L) ;left blank fill

 NEW %,I

 S %=$L(V),Z=L-% F I=1:1:Z S V=" "_V

 Q V

 ;

LASTCDR(V,F) ;EP - get last chart deficiency reason

 I $G(F)="" S F="I"  ;default to ien

 I '$D(^AUPNVCA("AD",V)) Q ""

 NEW X,A,D,L

 S X=0 F  S X=$O(^AUPNVCA("AD",V,X)) Q:X'=+X  D

 .Q:'$D(^AUPNVCA(X,0))

 .S D=$P(^AUPNVCA(X,0),U)

 .S A((9999999-$P(D,".")))=X

 S L=$O(A(0)) I L="" Q ""

 S X=A(L)

 Q $S(F="I":$P(^AUPNVCA(X,0),U,6),1:$$VAL^XBDIQ1(9000010.45,X,.06))

 ;

BACK ;EP - go back to listman

 D TERM^VALM0

 S VALMBCK="R"

 D INIT

 D HDR

 K DIR

 K X,Y,Z,I

 Q

 ;

NOTEDISP ;

 K DIR

 I $T(BROWS1^TIURA2)="" W !!,"TIU not installed" D EOP G NOTEX

 S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Display Note for which Visit"

 D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No VISIT selected." D EOP G NOTEX

 I $D(DIRUT) W !,"No VISIT selected." D EOP G NOTEX

 S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)

 D FULL^VALM1

 I '$D(^AUPNVNOT("AD",APCDVSIT)) W !!,"That visit does not have any notes to view" D EOP G NOTEX

 S (C,X)=0 F  S X=$O(^AUPNVNOT("AD",APCDVSIT,X)) Q:X'=+X  S C=C+1

 I C=1 S APCDVNOT=$O(^AUPNVNOT("AD",APCDVSIT,0)) D NOTE1 G NOTEX

 ;

MNOTE ;

 W !!,"There are more than one note associated with this visit.",!,"Please choose which note to display.",!

 K APCDN

 S (X,C)=0 F  S X=$O(^AUPNVNOT("AD",APCDVSIT,X)) Q:X'=+X  S C=C+1 D

 .W !?3,C,")  ",$$VAL^XBDIQ1(9000010.28,X,.01),?40,$$VAL^XBDIQ1(9000010.28,X,1202)

 .S APCDN(C)=X

 .Q

 K DIR

 S DIR(0)="NO^1:"_C,DIR("A")="Display which Note"

 D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" G NOTEX

 I $D(DIRUT) G NOTEX

 S APCDVNOT=APCDN(Y)

NOTE1 ;

 S APCDTIU=$P(^AUPNVNOT(APCDVNOT,0),U)

 D BROWS1^TIURA2("TIU BROWSE FOR READ ONLY",APCDTIU)

 ;

NOTEX ;

 K DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDVNOT,X,APCDTIU

 D KILL^AUPNPAT

 D BACK

 Q

 ;

CASHX ;EP

 D FULL^VALM1

 K DIR

 S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Display Chart Audit History for which Visit"

 D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No VISIT selected." D EOP G CASHXX

 I $D(DIRUT) W !,"No VISIT selected." D EOP G CASHXX

 S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)

 D VIEWR^XBLM("DCAH^APCDCAF")

 D EOP

 ;

CASHXX ;

 K DIR,DIRUT,DUOUT,Y,APCDVSIT

 D BACK

 Q

CDE ;EP

 K DIR

 S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Which Visit"

 D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No VISIT selected." D EOP^APCDCAF G CDEX

 I $D(DIRUT) W !,"No VISIT selected." D EOP^APCDCAF G CDEX

 S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)

 K VALMBCK

 S APCDCAFV=APCDVSIT,APCDPAT=$P(^AUPNVSIT(APCDVSIT,0),U,5) D EN^APCDCAF6(APCDVSIT)

 ;

CDEX ;

 K DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV

 ;

 D BACK

 Q

 ;

HS ;

 D FULL^VALM1

 I $G(APCDDFN) S (DFN,APCHSPAT,APCDPAT,Y)=APCDDFN G HS1

 K DIR

 S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Select Visit for Patient's Health summary"

 D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No VISIT selected." D EOP G HSX

 I $D(DIRUT) W !,"No VISIT selected." D EOP G HSX

 S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)

 S (Y,APCDPAT,DFN,APCHSPAT)=$P(^AUPNVSIT(APCDVSIT,0),U,5)

HS1 ;

 S X="" I DUZ(2),$D(^APCCCTRL(DUZ(2),0))#2 S X=$P(^(0),U,3) I X,$D(^APCHSCTL(X,0)) S X=$P(^APCHSCTL(X,0),U)

 I $D(^DISV(DUZ,"^APCHSCTL(")) S Y=^("^APCHSCTL(") I $D(^APCHSCTL(Y,0)) S X=$P(^(0),U,1)

 S:X="" X="ADULT REGULAR"

 K DIC,DR,DD S DIC("B")=X,DIC="^APCHSCTL(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DD,D0,D1,DQ

 I Y=-1 D EOP G HSX

 S APCHSTYP=+Y,APCHSPAT=DFN

 S APCDHDR="PCC Health Summary for "_$P(^DPT(APCHSPAT,0),U)

 D VIEWR^XBLM("EN^APCHS",APCDHDR)

HSX ;

 K APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,DFN,APCDHDR,APCDPLPT

 D EN^XBVK("APCH")

 D KILL^AUPNPAT

 D BACK

 Q

 ;

EOP ;EP - End of page.

 Q:$E(IOST)'="C"

 ;Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))

 NEW DIR

 K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 S DIR("A")="Press Enter to Continue",DIR(0)="E" D ^DIR

 Q

 ;----------

ADDVISIT ;

 S APCDCAF("IN CAF W/PATIENT")=APCDDFN

 D EN^XBNEW("^APCDEA","APCDCAF")

 K APCDCAF

 D BACK

 Q

BH ;EP

 K DIR

 ;I $T(BROWS1^TIURA2)="" W !!,"TIU not installed" D EOP G NOTEX

 I '$D(^XUSEC("AMHZ CODING REVIEW",DUZ)) W !!,"You do not have the security access to see Behavioral Health Notes.",!,"Please see your supervisor for access.  The security key needed is AMHZ CODING REVIEW.",! D PAUSE^APCDALV1,BHX Q

 S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Display Behavioral Health Note for which Visit"

 D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No VISIT selected." D EOP G BHX

 I $D(DIRUT) W !,"No VISIT selected." D EOP G BHX

 S APCDVSIT=^TMP("APCDCAF",$J,"IDX",Y,Y)

 D FULL^VALM1

 I '$D(^AMHREC("AVISIT",APCDVSIT)) D  G BHX

 .W !!,"There is no visit in the Behavioral Health module that is associated"

 .W !,"with this visit.  Use the N - Note Display action to display notes for "

 .W !,"non-BH visits."

 .D EOP

 S APCDVBH=$O(^AMHREC("AVISIT",APCDVSIT,0))

 I '$D(^AUPNVNOT("AD",APCDVSIT)) G BHSOAP

 S (C,X)=0 F  S X=$O(^AUPNVNOT("AD",APCDVSIT,X)) Q:X'=+X  S C=C+1

 I C=1 S APCDVNOT=$O(^AUPNVNOT("AD",APCDVSIT,0)) D BH1 G BHSOAP

 ;

BHM ;

 W !!,"There are more than one note associated with this visit.",!,"Please choose which note to display.",!

 K APCDN

 S (X,C)=0 F  S X=$O(^AUPNVNOT("AD",APCDVSIT,X)) Q:X'=+X  S C=C+1 D

 .W !?3,C,")  ",$$VAL^XBDIQ1(9000010.28,X,.01),?40,$$VAL^XBDIQ1(9000010.28,X,1202)

 .S APCDN(C)=X

 .Q

 K DIR

 S DIR(0)="NO^1:"_C,DIR("A")="Display which Note"

 D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" G BHSOAP

 I $D(DIRUT) G BHSOAP

 S APCDVNOT=APCDN(Y)

BH1 ;

 S APCDTIU=$P(^AUPNVNOT(APCDVNOT,0),U)

 D BROWS1^TIURA2("TIU BROWSE FOR READ ONLY",APCDTIU)

 ;

BHSOAP ;look for SOAP note and display if it exists

 I $O(^AMHREC(APCDVBH,31,0)) D

 .W !!,"The SOAP note from the Behavioral Health module will now be displayed."

 .W !! S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 .I $D(DIRUT) Q

 .I 'Y Q

 .D ARRAY^XBLM("^AMHREC("_APCDVBH_",31,","Behavior Health SOAP Note for visit: "_$$VAL^XBDIQ1(9002011,APCDVBH,.01))

 .Q

BHX ;

 K DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDVNOT,X,APCDTIU

 D KILL^AUPNPAT

 D BACK

 Q

VAV ;EP - view any visit when in OP

 ;

 Q

CP ;EP - change patient if in one patient

 ;

 D FULL^VALM1

 I '$D(APCDPEHR) W !!,"This item is only allowed to be used when you are in the PEHR option." D PAUSE^APCDALV1,BACK^APCDCAF Q

 ;change patient

 W !

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC

 I Y<0 D BACK^APCDCAF Q

 I $D(APCDPARM),$P(APCDPARM,U,3)="Y" W !?25,"Ok" S %=1 D YN^DICN Q:%'=1

 S (DFN,APCDPATF)=+Y

PROC1 ; call listmanager

 S APCDCAFP=DFN,APCDBD=$P(^APCCCTRL(DUZ(2),0),U,12),APCDED=DT,APCDPEHR=1

 D BACK^APCDCAF

 Q

DISP ;EP

 D FULL^VALM1

 D EN^XBNEW("DISP1^APCDCAF2","VALM*;APCDCAFP;APCDPEHR;DFN")

 ;

 ;

DISPX ;

 K DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV

 D KILL^AUPNPAT

 D BACK

 Q

DISP1 ;

 S APCDPAT=DFN

 D GETVISIT^APCDDISP

 I '$G(APCDVSIT) W !!,"No visit selected." D PAUSE^APCDALV1 Q

 D DSPLY^APCDDISP

 D PAUSE^APCDALV1

 Q

APCDCAF2  ; IHS/CMI/LAB - MENTAL HLTH ROUTINE 16-AUG-1994 ;

 +1       ;;2.0;IHS PCC SUITE;**2,7,8,11**;MAY 14, 2009;Build 58

 +2       ;; ;

 +3       ;

EN        ; EP -- main entry point for CHART AUDIT LISTMANAGER DISPLAY

 +1        SET VALMCC=1

 +2        NEW VALMCNT

 +3        DO TERM^VALM0

 +4        DO CLEAR^VALM1

 +5        DO EN^VALM("APCDCAF OP MAIN VIEW")

 +6        DO CLEAR^VALM1

 +7        KILL ^TMP($JOB),^TMP("APCDCAF OP",$JOB)

 +8        QUIT 

 +9       ;

HDR       ;EP -- header code

 +1        SET X=" #"

           SET $EXTRACT(X,6)="VISIT DATE"

           SET $EXTRACT(X,21)="PATIENT NAME"

           SET $EXTRACT(X,38)="HRN"

           SET $EXTRACT(X,44)="FAC"

           SET $EXTRACT(X,49)="HOSP LOC"

           SET $EXTRACT(X,59)="S"

           SET $EXTRACT(X,61)="CL"

           SET $EXTRACT(X,64)="PRIM PROV"

           SET $EXTRACT(X,75)="STATUS ERROR"

 +2        SET VALMHDR(2)=X

 +3        SET VALMHDR(1)="* an asterisk beside the visit number indicates the visit has an error"

 +4        QUIT 

 +5       ;

INIT      ;EP -- init variables and list array

 +1        SET VALMSG="Q - Quit/?? for more actions/+ next/- previous"

 +2       ;GATHER UP ALL VISITS FOR DISPLAY

           DO GATHER

 +3       ;sort list by desired sort variable and set up listman display

           DO RECDISP

 +4        SET VALMCNT=APCDRCNT

 +5        QUIT 

 +6       ;

HELP      ;EP -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL APCDRCNT,^TMP($JOB,"APCDCAF OP"),^TMP($JOB)

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

GATHER    ;

 +1        KILL ^TMP($JOB),^TMP("APCDCAF OP",$JOB)

 +2        SET APCDODAT=9999999-APCDCAFD

           SET APCDSTOP=9999999-APCDCAFD

 +3        SET (APCDRCNT,APCDVIEN)=0

           FOR 

               SET APCDODAT=$ORDER(^AUPNVSIT("AA",APCDDFN,APCDODAT))

               IF APCDODAT=""!($PIECE(APCDODAT,".")>APCDSTOP)

                   QUIT 

               Begin DoDot:1

 +4                SET APCDVIEN=0

                   FOR 

                       SET APCDVIEN=$ORDER(^AUPNVSIT("AA",APCDDFN,APCDODAT,APCDVIEN))

                       IF APCDVIEN'=+APCDVIEN

                           QUIT 

                       Begin DoDot:2

 +5                        SET APCDV0=$GET(^AUPNVSIT(APCDVIEN,0))

 +6                        IF APCDV0=""

                               QUIT 

 +7       ;DELETED

                           IF $PIECE(APCDV0,U,11)

                               QUIT 

 +8       ;CONTRACT

                           IF $PIECE(APCDV0,U,3)="C"

                               QUIT 

 +9                        SET APCDVLOC=$PIECE(APCDV0,U,6)

 +10      ;no location of encounter

                           IF APCDVLOC=""

                               QUIT 

 +11                       SET ^TMP($JOB,"APCDCAF OP",APCDVIEN,APCDVIEN)=""

 +12                       QUIT 

                       End DoDot:2

 +13               QUIT 

               End DoDot:1

 +14       QUIT 

RECDISP   ;

 +1        SET APCDSV=""

           FOR 

               SET APCDSV=$ORDER(^TMP($JOB,"APCDCAF OP",APCDSV))

               IF APCDSV=""

                   QUIT 

               Begin DoDot:1

 +2                SET APCDV=0

                   FOR 

                       SET APCDV=$ORDER(^TMP($JOB,"APCDCAF OP",APCDSV,APCDV))

                       IF APCDV'=+APCDV

                           QUIT 

                       Begin DoDot:2

 +3                        SET APCDRCNT=APCDRCNT+1

 +4                        SET APCDX=""

                           SET DFN=$PIECE(^AUPNVSIT(APCDV,0),U,5)

                           DO REC

 +5                        SET ^TMP("APCDCAF OP",$JOB,APCDRCNT,0)=APCDX

 +6                        SET ^TMP("APCDCAF OP",$JOB,"IDX",APCDRCNT,APCDRCNT)=APCDV

                       End DoDot:2

               End DoDot:1

 +7        KILL APCDV,APCDX,APCDSV

 +8        QUIT 

 +9       ;

DATE(D)   ;

 +1        NEW X,Y

 +2        SET X=$PIECE(D,".")

 +3        SET X=$EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)

 +4        SET Y=$$FMTE^XLFDT(D,"2S")

           SET Y=$PIECE(Y,"@",2)

           SET Y=$PIECE(Y,":",1,2)

 +5        QUIT X_"@"_Y

 +6       ;

REC       ;

 +1        SET APCDERR=$$ERRORCHK^APCDCAF(APCDV)

 +2        SET APCDX=""

 +3        SET APCDX=APCDRCNT_")"_$SELECT(APCDERR]"":"*",1:"")

 +4        SET $EXTRACT(APCDX,6)=$$DATE($PIECE(^AUPNVSIT(APCDV,0),U))

 +5        SET $EXTRACT(APCDX,21)=$EXTRACT($PIECE(^DPT(DFN,0),U),1,15)

 +6        SET $EXTRACT(APCDX,37)=$$LBLK($$HRN^AUPNPAT(DFN,DUZ(2)),6)

 +7        SET L=$PIECE(^AUPNVSIT(APCDV,0),U,6)

 +8        SET L=$PIECE($GET(^AUTTLOC(L,0)),U,7)

 +9        SET $EXTRACT(APCDX,44)=L

 +10       SET $EXTRACT(APCDX,49)=$EXTRACT($$VAL^XBDIQ1(9000010,APCDV,.22),1,9)

 +11       SET $EXTRACT(APCDX,59)=$PIECE(^AUPNVSIT(APCDV,0),U,7)

 +12       SET $EXTRACT(APCDX,61)=$$CLINIC^APCLV(APCDV,"C")

 +13       SET $EXTRACT(APCDX,64)=$EXTRACT($$PRIMPROV^APCLV(APCDV,"N"),1,10)

 +14       SET L=$PIECE($GET(^AUPNVSIT(APCDV,11)),U,11)

 +15       SET $EXTRACT(APCDX,75)=L

 +16       SET $EXTRACT(APCDX,77)=APCDERR

 +17       QUIT 

 +18      ;

RBLK(V,L) ;left blank fill

 +1        NEW %,I

 +2        SET %=$LENGTH(V)

           SET Z=L-%

           FOR I=1:1:Z

               SET V=V_" "

 +3        QUIT V

LBLK(V,L) ;left blank fill

 +1        NEW %,I

 +2        SET %=$LENGTH(V)

           SET Z=L-%

           FOR I=1:1:Z

               SET V=" "_V

 +3        QUIT V

 +4       ;

LASTCDR(V,F) ;EP - get last chart deficiency reason

 +1       ;default to ien

           IF $GET(F)=""

               SET F="I"

 +2        IF '$DATA(^AUPNVCA("AD",V))

               QUIT ""

 +3        NEW X,A,D,L

 +4        SET X=0

           FOR 

               SET X=$ORDER(^AUPNVCA("AD",V,X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +5                IF '$DATA(^AUPNVCA(X,0))

                       QUIT 

 +6                SET D=$PIECE(^AUPNVCA(X,0),U)

 +7                SET A((9999999-$PIECE(D,".")))=X

               End DoDot:1

 +8        SET L=$ORDER(A(0))

           IF L=""

               QUIT ""

 +9        SET X=A(L)

 +10       QUIT $SELECT(F="I":$PIECE(^AUPNVCA(X,0),U,6),1:$$VAL^XBDIQ1(9000010.45,X,.06))

 +11      ;

BACK      ;EP - go back to listman

 +1        DO TERM^VALM0

 +2        SET VALMBCK="R"

 +3        DO INIT

 +4        DO HDR

 +5        KILL DIR

 +6        KILL X,Y,Z,I

 +7        QUIT 

 +8       ;

NOTEDISP  ;

 +1        KILL DIR

 +2        IF $TEXT(BROWS1^TIURA2)=""

               WRITE !!,"TIU not installed"

               DO EOP

               GOTO NOTEX

 +3        SET DIR(0)="NO^1:"_APCDRCNT

           SET DIR("A")="Display Note for which Visit"

 +4        DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +5        IF Y=""

               WRITE !,"No VISIT selected."

               DO EOP

               GOTO NOTEX

 +6        IF $DATA(DIRUT)

               WRITE !,"No VISIT selected."

               DO EOP

               GOTO NOTEX

 +7        SET APCDVSIT=^TMP("APCDCAF OP",$JOB,"IDX",Y,Y)

 +8        DO FULL^VALM1

 +9        IF '$DATA(^AUPNVNOT("AD",APCDVSIT))

               WRITE !!,"That visit does not have any notes to view"

               DO EOP

               GOTO NOTEX

 +10       SET (C,X)=0

           FOR 

               SET X=$ORDER(^AUPNVNOT("AD",APCDVSIT,X))

               IF X'=+X

                   QUIT 

               SET C=C+1

 +11       IF C=1

               SET APCDVNOT=$ORDER(^AUPNVNOT("AD",APCDVSIT,0))

               DO NOTE1

               GOTO NOTEX

 +12      ;

MNOTE     ;

 +1        WRITE !!,"There are more than one note associated with this visit.",!,"Please choose which note to display.",!

 +2        KILL APCDN

 +3        SET (X,C)=0

           FOR 

               SET X=$ORDER(^AUPNVNOT("AD",APCDVSIT,X))

               IF X'=+X

                   QUIT 

               SET C=C+1

               Begin DoDot:1

 +4                WRITE !?3,C,")  ",$$VAL^XBDIQ1(9000010.28,X,.01),?40,$$VAL^XBDIQ1(9000010.28,X,1202)

 +5                SET APCDN(C)=X

 +6                QUIT 

               End DoDot:1

 +7        KILL DIR

 +8        SET DIR(0)="NO^1:"_C

           SET DIR("A")="Display which Note"

 +9        DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +10       IF Y=""

               GOTO NOTEX

 +11       IF $DATA(DIRUT)

               GOTO NOTEX

 +12       SET APCDVNOT=APCDN(Y)

NOTE1     ;

 +1        SET APCDTIU=$PIECE(^AUPNVNOT(APCDVNOT,0),U)

 +2        DO BROWS1^TIURA2("TIU BROWSE FOR READ ONLY",APCDTIU)

 +3       ;

NOTEX     ;

 +1        KILL DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDVNOT,X,APCDTIU

 +2        DO KILL^AUPNPAT

 +3        DO BACK

 +4        QUIT 

 +5       ;

CASHX     ;EP

 +1        DO FULL^VALM1

 +2        KILL DIR

 +3        SET DIR(0)="NO^1:"_APCDRCNT

           SET DIR("A")="Display Chart Audit History for which Visit"

 +4        DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +5        IF Y=""

               WRITE !,"No VISIT selected."

               DO EOP

               GOTO CASHXX

 +6        IF $DATA(DIRUT)

               WRITE !,"No VISIT selected."

               DO EOP

               GOTO CASHXX

 +7        SET APCDVSIT=^TMP("APCDCAF OP",$JOB,"IDX",Y,Y)

 +8        DO VIEWR^XBLM("DCAH^APCDCAF")

 +9        DO EOP

 +10      ;

CASHXX    ;

 +1        KILL DIR,DIRUT,DUOUT,Y,APCDVSIT

 +2        DO BACK

 +3        QUIT 

CDE       ;EP

 +1        KILL DIR

 +2        SET DIR(0)="NO^1:"_APCDRCNT

           SET DIR("A")="Which Visit"

 +3        DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF Y=""

               WRITE !,"No VISIT selected."

               DO EOP^APCDCAF

               GOTO CDEX

 +5        IF $DATA(DIRUT)

               WRITE !,"No VISIT selected."

               DO EOP^APCDCAF

               GOTO CDEX

 +6        SET APCDVSIT=^TMP("APCDCAF OP",$JOB,"IDX",Y,Y)

 +7        KILL VALMBCK

 +8        SET APCDCAFV=APCDVSIT

           SET APCDPAT=$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)

           DO EN^APCDCAF6(APCDVSIT)

 +9       ;

CDEX      ;

 +1        KILL DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV

 +2       ;

 +3        DO BACK

 +4        QUIT 

 +5       ;

HS        ;

 +1        DO FULL^VALM1

 +2        IF $GET(APCDDFN)

               SET (DFN,APCHSPAT,APCDPAT,Y)=APCDDFN

               GOTO HS1

 +3        KILL DIR

 +4        SET DIR(0)="NO^1:"_APCDRCNT

           SET DIR("A")="Select Visit for Patient's Health summary"

 +5        DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +6        IF Y=""

               WRITE !,"No VISIT selected."

               DO EOP

               GOTO HSX

 +7        IF $DATA(DIRUT)

               WRITE !,"No VISIT selected."

               DO EOP

               GOTO HSX

 +8        SET APCDVSIT=^TMP("APCDCAF OP",$JOB,"IDX",Y,Y)

 +9        SET (Y,APCDPAT,DFN,APCHSPAT)=$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)

HS1       ;

 +1        SET X=""

           IF DUZ(2)

               IF $DATA(^APCCCTRL(DUZ(2),0))#2

                   SET X=$PIECE(^(0),U,3)

                   IF X

                       IF $DATA(^APCHSCTL(X,0))

                           SET X=$PIECE(^APCHSCTL(X,0),U)