AMHLEPOV.m

AMHLEPOV ; IHS/CMI/LAB - NEW PROGRAM ;

 ;;4.0;IHS BEHAVIORAL HEALTH;**4**;JUN 18, 2010;Build 28

 ;

 ;

 ;GET POVS, ADD TO PROBLEM LIST, ADD TO PCC PROBLEM LIST

 ;CALLED IN RECORD ADD

START ;EP

 D EN^XBNEW("EP^AMHLEPOV","AMH*")

 Q

EP2 ;EP

 S APCDOVRR=""

 D EN^XBNEW("EP^AMHLEPOV","AMHR;AMHPAT;AMHLOC;AMHDATE;APCDOVRR;AMHGROUP")

 Q

EP ;EP  -  ask for POV and file each

 I 'AMHR W !!,"NO RECORD DEFINED!!" D XIT Q

 I '$D(^AMHREC(AMHR)) W !!,"NO RECORD!!" D XIT Q

 S APCDOVRR=""

 F  S AMHPOV="" D POV Q:AMHPOV=""

 D CHK

 D XIT

 Q

CHK ;

 Q:$D(^AMHRPRO("AD",AMHR))

 W !!,$C(7),$C(7),"At least ONE POV is REQUIRED!!"

 S DIR(0)="Y",DIR("A")="Do you wish to exit and delete this record",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $G(Y)=0 G EP

 Q

POV ;

 D HPOV1^AMHLESM

 I $G(AMHDET)="S" W @IOF,!!?15,"******* PURPOSE OF VISIT *******",!

 S AMHDT=$P(AMHDATE,".")

 S DIC("A")=$S($G(AMHGROUP):"Enter another Problem (POV) for this patient: ",'$D(^AMHRPRO("AD",AMHR)):"Enter PRIMARY Problem-POV: ",1:"Enter ANOTHER Problem-POV: "),DIC("S")="I '$P(^(0),U,13)",DIC="^AMHPROB(",DIC(0)="AEMQ"

 W ! D ^DIC

 I Y=-1 D ^XBFMK Q

 S AMHPOV=$P(Y,U,2),AMHPOVP=+Y

 ;call FILE^DICN to file this POV

FILE ;

 D ^XBFMK

 K DD,D0,DO,DINUM,DIC,DA,DR S DIC(0)="EL",DIC="^AMHRPRO(",DLAYGO=9002011.01,DIADD=1,X=AMHPOVP,DIC("DR")="" D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0

 I Y=-1 D ^XBFMK,XIT W !!,$C(7),$C(7),"Behavioral Health POV failed!!  Notify Site Manager." Q

 S AMHRPRO=+Y,AMHPOVR=^AMHRPRO(AMHRPRO,0)

 D ^XBFMK

 S DIE("NO^")="",DA=AMHRPRO,DIE="^AMHRPRO(",DR=".02////"_$G(AMHPAT)_";.03////"_AMHR_";.04  Provider Narrative.....:" S DIE("NO^")="" D CALLDIE^AMHLEIN

 S AMHPOVR=^AMHRPRO(AMHRPRO,0)

 I $P(AMHPOVR,U,4)="" S X=$E($P(^AMHPROB($P(AMHPOVR,U),0),U,2),1,$S($P(^DD(9999999.27,.01,0),U,5)[">160":159,1:79)),X=$TR(X,";"," "),DIE="^AMHRPRO(",DR=".04///"_X,DA=AMHRPRO S DIE("NO^")="" D CALLDIE^AMHLEIN

 I $D(Y) D ^XBFMK,XIT W !!,$C(7),$C(7),"DIE failed when updating POV" D PAUSE^AMHLEA Q

 S AMHPOVR=^AMHRPRO(AMHRPRO,0)

 S AMHNARR=$S($P(AMHPOVR,U,4):$P(^AUTNPOV($P(AMHPOVR,U,4),0),U),1:"<NO PROVIDER NARRATIVE RECORDED>")

 Q:$G(AMHVTYPE)'="R"

 I '$G(AMHGROUP) D BHPROB

 I '$G(AMHGROUP) D PCCPROB

 Q

BHPROB ;add to BH Problem List?

 Q:'$G(AMHPAT)  ;not if no patient

 Q:$P(^AMHREC(AMHR,0),U,8)=""  ;no patient

 W ! S DIR(0)="Y",DIR("A")="ADD this PROBLEM to the BH PROBLEM LIST",DIR("B")="N",DIR("?")="If the Provider has checked the box labeled ADD TO BH PROBLEM LIST, answer YES" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 Q:'Y

ADDBH ;

 D ^AMHDMHPL

 W !,"Add this problem - ",$P(^AMHPROB(AMHPOVP,0),U)," - ",$P(^AMHPROB(AMHPOVP,0),U,2) S DIR(0)="Y",DIR("A")="     to the BH Problem List",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 Q:'Y

 S AMHTX=0,AMHTY="" F  S AMHTY=$O(^AMHPPROB("AA",AMHPAT,AMHTY)) Q:AMHTY=""  S AMHTX=$E(AMHTY,2,4)

 S AMHTX=AMHTX+1 K AMHTY

 K DD,D0,DO,DINUM,DIC,DA,DR S DIC(0)="EL",DIC="^AMHPPROB(",DLAYGO=9002011.51,DIADD=1,X=AMHPOVP,DIC("DR")=""

 K DD,D0,DO D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0

 I Y=-1 D ^XBFMK,XIT W !!,$C(7),$C(7),"Behavioral Health PROBLEM ADD failed!!  Notify Site Manager." D PAUSE^AMHLEA Q

 S AMHPIEN=+Y

 S APCDOVRR=""

 S DA=AMHPIEN,DIE="^AMHPPROB(",DR=".02////"_AMHPAT_";.03///^S X=AMHDT;.08///^S X=AMHDT;.05///"_AMHNARR_";.06////"_$S($G(AMHLOC):AMHLOC,1:DUZ(2))_";.07///"_AMHTX_";.12//A;.13" S DIE("NO^")="" D CALLDIE^AMHLEIN

 I $D(Y) W !!,$C(7),"Adding a BH Problem FAILED!" D PAUSE^AMHLEA Q

 S DIE="^AMHPPROB(",DA=AMHPIEN,DR="[AMH ADD TREATMENT NOTES/POV]" D CALLDIE^AMHLEIN

 I $D(Y) W !!,"Updating NOTES failed." Q

 Q

PCCPROB ;add to PCC Problem List?

 Q:'$$ASKPCC^AMHLEIN(DUZ(2))

 Q:'$G(AMHPAT)

 Q:$P(^AMHPROB(AMHPOVP,0),U,5)=""

 I $P(^AMHPROB(AMHPOVP,0),U,8),'$P(^(0),U,12) Q

 S DIR(0)="Y",DIR("A")="ADD this PROBLEM to the PCC PROBLEM LIST",DIR("B")="N",DIR("?")="If the Provider has checked the box labeled ADD TO PCC PROBLEM LIST, answer YES" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 W !

 Q:$D(DIRUT)

 Q:'Y

 ;

ADDPCC ;

 I $G(AMHLOC)="" S AMHLOC=DUZ(2)

 D ^AMHPROB

 W !,"Add problem - ",$P(^AMHPROB(AMHPOVP,0),U)," - ",$P(^AMHPROB(AMHPOVP,0),U,2) S DIR(0)="Y",DIR("A")="     to the PCC PROBLEM LIST",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 Q:'Y

 S X=0,Y="" F  S Y=$O(^AUPNPROB("AA",AMHPAT,AMHLOC,Y)) Q:Y=""  S X=$E(Y,2,4)

 S AMHNUM=X+1

 S X=$P(^AMHPROB($P(AMHPOVR,U),0),U,5)

 Q:X=""

 S X=+$$CODEN^ICDCODE(X,80)

 Q:X=""

 Q:X=-1

 S X="`"_X,DIC="^AUPNPROB(",DIADD=1,DLAYGO=9000011,DIC(0)="L" D ^DIC K DIC,DIADD,DLAYGO I Y=-1 D ^XBFMK,XIT W !!,"ERROR WHILE ATTEMPTING TO UPDATE PCC PROBLEM LIST" Q

 ;get appropriate narrative to pass

 S APCDOVRR=""

 W !,"This is the narrative that the rest of the Medical community will see on the PCC",!,"Problem List on the PCC Health Summary.  You may change it now if desired.",!

 I AMHDET="R" S AMHNARR=$S('$P(^AMHPROB($P(AMHPOVR,U),0),U,12):$P(^AUTNPOV($P(AMHPOVR,U,4),0),U),1:$E($P(^AMHPROB($P(AMHPOVR,U),0),U,2),1,35)_" - "_$E($P(^AUTNPOV($P(AMHPOVR,U,4),0),U),1,40))

 S DA=+Y,DIE="^AUPNPROB(",DR=".02////"_AMHPAT S Y=AMHDT D DD^%DT S DR=DR_";.03///"_Y_";.05//"_$G(AMHNARR)_";.06////"_AMHLOC_";.07////"_AMHNUM_";.08///"_Y_";.12///A;.13"

 D CALLDIE^AMHLEIN K DA,DIE,DR,DIU,DIV,DIW

 W !

 I $D(Y) W !!,"ERROR WHILE ATTEMPTING TO UPDATE PCC PROBLEM LIST!!"

 K AMHNUMB,X,Y

 Q

XIT ;

 K DIADD,DLAYGO

 K AMHTX,AMHTY,AMHNARR,AMHLEPT,AMHNUM,AMHPOV,AMHPOVP,AMHPOVR,AMHRPRO,AMHDT,AMHLOOK

 Q

EN ;EP add to mhss problem list - screen man call

 D EN^XBNEW("EN1^AMHLEPOV","AMH*") ;  new everthing except AMH*

 Q

 ;

EN1 ; ENTRY POINT FOR ^XBNEW

 W:$D(IOF) @IOF

 S AMHDT=$P(AMHDATE,".")

 D ADDBH

 D XIT

 Q

EN2 ;EP add to pcc problem list - screen man call

 D EN^XBNEW("EN3^AMHLEPOV","AMH*")

 Q

EN3 ;

 W:$D(IOF) @IOF

 S AMHDT=$P(AMHDATE,".")

 I '$$ASKPCC^AMHLEIN(DUZ(2)) W !!,"PARAMETER SET TO NO PCC PROBLEM LIST UPDATING",! H 5 Q

 Q:'$G(AMHPAT)

 I $P(^AMHPROB(AMHPOVP,0),U,5)="" W !!,"THIS PROBLEM CODE CANNOT BE ADDED TO A PCC PROBLEM LIST!!",!! H 5 Q

 I $P(^AMHPROB(AMHPOVP,0),U,8)=1 W !!,"THIS PROBLEM CODE CANNOT BE ADDED TO A PCC PROBLEM LIST!!",!! H 5 Q

 I '$G(AMHLOC) S AMHLOC=$$GET^DDSVAL(9002011,AMHR,".04","I")

 D ADDPCC

 Q

AMHLEPOV  ; IHS/CMI/LAB - NEW PROGRAM ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**4**;JUN 18, 2010;Build 28

 +2       ;

 +3       ;

 +4       ;GET POVS, ADD TO PROBLEM LIST, ADD TO PCC PROBLEM LIST

 +5       ;CALLED IN RECORD ADD

START     ;EP

 +1        DO EN^XBNEW("EP^AMHLEPOV","AMH*")

 +2        QUIT 

EP2       ;EP

 +1        SET APCDOVRR=""

 +2        DO EN^XBNEW("EP^AMHLEPOV","AMHR;AMHPAT;AMHLOC;AMHDATE;APCDOVRR;AMHGROUP")

 +3        QUIT 

EP        ;EP  -  ask for POV and file each

 +1        IF 'AMHR

               WRITE !!,"NO RECORD DEFINED!!"

               DO XIT

               QUIT 

 +2        IF '$DATA(^AMHREC(AMHR))

               WRITE !!,"NO RECORD!!"

               DO XIT

               QUIT 

 +3        SET APCDOVRR=""

 +4        FOR 

               SET AMHPOV=""

               DO POV

               IF AMHPOV=""

                   QUIT 

 +5        DO CHK

 +6        DO XIT

 +7        QUIT 

CHK       ;

 +1        IF $DATA(^AMHRPRO("AD",AMHR))

               QUIT 

 +2        WRITE !!,$CHAR(7),$CHAR(7),"At least ONE POV is REQUIRED!!"

 +3        SET DIR(0)="Y"

           SET DIR("A")="Do you wish to exit and delete this record"

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $GET(Y)=0

               GOTO EP

 +5        QUIT 

POV       ;

 +1        DO HPOV1^AMHLESM

 +2        IF $GET(AMHDET)="S"

               WRITE @IOF,!!?15,"******* PURPOSE OF VISIT *******",!

 +3        SET AMHDT=$PIECE(AMHDATE,".")

 +4        SET DIC("A")=$SELECT($GET(AMHGROUP):"Enter another Problem (POV) for this patient: ",'$DATA(^AMHRPRO("AD",AMHR)):"Enter PRIMARY Problem-POV: ",1:"Enter ANOTHER Problem-POV: ")

           SET DIC("S")="I '$P(^(0),U,13)"

           SET DIC="^AMHPROB("

           SET DIC(0)="AEMQ"

 +5        WRITE !

           DO ^DIC

 +6        IF Y=-1

               DO ^XBFMK

               QUIT 

 +7        SET AMHPOV=$PIECE(Y,U,2)

           SET AMHPOVP=+Y

 +8       ;call FILE^DICN to file this POV

FILE      ;

 +1        DO ^XBFMK

 +2        KILL DD,D0,DO,DINUM,DIC,DA,DR

           SET DIC(0)="EL"

           SET DIC="^AMHRPRO("

           SET DLAYGO=9002011.01

           SET DIADD=1

           SET X=AMHPOVP

           SET DIC("DR")=""

           DO FILE^DICN

           KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0

 +3        IF Y=-1

               DO ^XBFMK

               DO XIT

               WRITE !!,$CHAR(7),$CHAR(7),"Behavioral Health POV failed!!  Notify Site Manager."

               QUIT 

 +4        SET AMHRPRO=+Y

           SET AMHPOVR=^AMHRPRO(AMHRPRO,0)

 +5        DO ^XBFMK

 +6        SET DIE("NO^")=""

           SET DA=AMHRPRO

           SET DIE="^AMHRPRO("

           SET DR=".02////"_$GET(AMHPAT)_";.03////"_AMHR_";.04  Provider Narrative.....:"

           SET DIE("NO^")=""

           DO CALLDIE^AMHLEIN

 +7        SET AMHPOVR=^AMHRPRO(AMHRPRO,0)

 +8        IF $PIECE(AMHPOVR,U,4)=""

               SET X=$EXTRACT($PIECE(^AMHPROB($PIECE(AMHPOVR,U),0),U,2),1,$SELECT($PIECE(^DD(9999999.27,.01,0),U,5)[">160":159,1:79))

               SET X=$TRANSLATE(X,";"," ")

               SET DIE="^AMHRPRO("

               SET DR=".04///"_X

               SET DA=AMHRPRO

               SET DIE("NO^")=""

               DO CALLDIE^AMHLEIN

 +9        IF $DATA(Y)

               DO ^XBFMK

               DO XIT

               WRITE !!,$CHAR(7),$CHAR(7),"DIE failed when updating POV"

               DO PAUSE^AMHLEA

               QUIT 

 +10       SET AMHPOVR=^AMHRPRO(AMHRPRO,0)

 +11       SET AMHNARR=$SELECT($PIECE(AMHPOVR,U,4):$PIECE(^AUTNPOV($PIECE(AMHPOVR,U,4),0),U),1:"<NO PROVIDER NARRATIVE RECORDED>")

 +12       IF $GET(AMHVTYPE)'="R"

               QUIT 

 +13       IF '$GET(AMHGROUP)

               DO BHPROB

 +14       IF '$GET(AMHGROUP)

               DO PCCPROB

 +15       QUIT 

BHPROB    ;add to BH Problem List?

 +1       ;not if no patient

           IF '$GET(AMHPAT)

               QUIT 

 +2       ;no patient

           IF $PIECE(^AMHREC(AMHR,0),U,8)=""

               QUIT 

 +3        WRITE !

           SET DIR(0)="Y"

           SET DIR("A")="ADD this PROBLEM to the BH PROBLEM LIST"

           SET DIR("B")="N"

           SET DIR("?")="If the Provider has checked the box labeled ADD TO BH PROBLEM LIST, answer YES"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $DATA(DIRUT)

               QUIT 

 +5        IF 'Y

               QUIT 

ADDBH     ;

 +1        DO ^AMHDMHPL

 +2        WRITE !,"Add this problem - ",$PIECE(^AMHPROB(AMHPOVP,0),U)," - ",$PIECE(^AMHPROB(AMHPOVP,0),U,2)

           SET DIR(0)="Y"

           SET DIR("A")="     to the BH Problem List"

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               QUIT 

 +4        IF 'Y

               QUIT 

 +5        SET AMHTX=0

           SET AMHTY=""

           FOR 

               SET AMHTY=$ORDER(^AMHPPROB("AA",AMHPAT,AMHTY))

               IF AMHTY=""

                   QUIT 

               SET AMHTX=$EXTRACT(AMHTY,2,4)

 +6        SET AMHTX=AMHTX+1

           KILL AMHTY

 +7        KILL DD,D0,DO,DINUM,DIC,DA,DR

           SET DIC(0)="EL"

           SET DIC="^AMHPPROB("

           SET DLAYGO=9002011.51

           SET DIADD=1

           SET X=AMHPOVP

           SET DIC("DR")=""

 +8        KILL DD,D0,DO

           DO FILE^DICN

           KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0

 +9        IF Y=-1

               DO ^XBFMK

               DO XIT

               WRITE !!,$CHAR(7),$CHAR(7),"Behavioral Health PROBLEM ADD failed!!  Notify Site Manager."

               DO PAUSE^AMHLEA

               QUIT 

 +10       SET AMHPIEN=+Y

 +11       SET APCDOVRR=""

 +12       SET DA=AMHPIEN

           SET DIE="^AMHPPROB("

           SET DR=".02////"_AMHPAT_";.03///^S X=AMHDT;.08///^S X=AMHDT;.05///"_AMHNARR_";.06////"_$SELECT($GET(AMHLOC):AMHLOC,1:DUZ(2))_";.07///"_AMHTX_";.12//A;.13"

           SET DIE("NO^")=""

           DO CALLDIE^AMHLEIN

 +13       IF $DATA(Y)

               WRITE !!,$CHAR(7),"Adding a BH Problem FAILED!"

               DO PAUSE^AMHLEA

               QUIT 

 +14       SET DIE="^AMHPPROB("

           SET DA=AMHPIEN

           SET DR="[AMH ADD TREATMENT NOTES/POV]"

           DO CALLDIE^AMHLEIN

 +15       IF $DATA(Y)

               WRITE !!,"Updating NOTES failed."

               QUIT 

 +16       QUIT 

PCCPROB   ;add to PCC Problem List?

 +1        IF '$$ASKPCC^AMHLEIN(DUZ(2))

               QUIT 

 +2        IF '$GET(AMHPAT)

               QUIT 

 +3        IF $PIECE(^AMHPROB(AMHPOVP,0),U,5)=""

               QUIT 

 +4        IF $PIECE(^AMHPROB(AMHPOVP,0),U,8)

               IF '$PIECE(^(0),U,12)

                   QUIT 

 +5        SET DIR(0)="Y"

           SET DIR("A")="ADD this PROBLEM to the PCC PROBLEM LIST"

           SET DIR("B")="N"

           SET DIR("?")="If the Provider has checked the box labeled ADD TO PCC PROBLEM LIST, answer YES"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +6        WRITE !

 +7        IF $DATA(DIRUT)

               QUIT 

 +8        IF 'Y

               QUIT 

 +9       ;

ADDPCC    ;

 +1        IF $GET(AMHLOC)=""

               SET AMHLOC=DUZ(2)

 +2        DO ^AMHPROB

 +3        WRITE !,"Add problem - ",$PIECE(^AMHPROB(AMHPOVP,0),U)," - ",$PIECE(^AMHPROB(AMHPOVP,0),U,2)

           SET DIR(0)="Y"

           SET DIR("A")="     to the PCC PROBLEM LIST"

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $DATA(DIRUT)

               QUIT 

 +5        IF 'Y

               QUIT 

 +6        SET X=0

           SET Y=""

           FOR 

               SET Y=$ORDER(^AUPNPROB("AA",AMHPAT,AMHLOC,Y))

               IF Y=""

                   QUIT 

               SET X=$EXTRACT(Y,2,4)

 +7        SET AMHNUM=X+1

 +8        SET X=$PIECE(^AMHPROB($PIECE(AMHPOVR,U),0),U,5)

 +9        IF X=""

               QUIT 

 +10       SET X=+$$CODEN^ICDCODE(X,80)

 +11       IF X=""

               QUIT 

 +12       IF X=-1

               QUIT 

 +13       SET X="`"_X

           SET DIC="^AUPNPROB("

           SET DIADD=1

           SET DLAYGO=9000011

           SET DIC(0)="L"

           DO ^DIC

           KILL DIC,DIADD,DLAYGO

           IF Y=-1

               DO ^XBFMK

               DO XIT

               WRITE !!,"ERROR WHILE ATTEMPTING TO UPDATE PCC PROBLEM LIST"

               QUIT 

 +14      ;get appropriate narrative to pass

 +15       SET APCDOVRR=""

 +16       WRITE !,"This is the narrative that the rest of the Medical community will see on the PCC",!,"Problem List on the PCC Health Summary.  You may change it now if desired.",!

 +17       IF AMHDET="R"

               SET AMHNARR=$SELECT('$PIECE(^AMHPROB($PIECE(AMHPOVR,U),0),U,12):$PIECE(^AUTNPOV($PIECE(AMHPOVR,U,4),0),U),1:$EXTRACT($PIECE(^AMHPROB($PIECE(AMHPOVR,U),0),U,2),1,35)_" - "_$EXTRACT($PIECE(^AUTNPOV($PIECE(AMHPOVR,U,4),0),U),1,40))

 +18       SET DA=+Y

           SET DIE="^AUPNPROB("

           SET DR=".02////"_AMHPAT

           SET Y=AMHDT

           DO DD^%DT

           SET DR=DR_";.03///"_Y_";.05//"_$GET(AMHNARR)_";.06////"_AMHLOC_";.07////"_AMHNUM_";.08///"_Y_";.12///A;.13"

 +19       DO CALLDIE^AMHLEIN

           KILL DA,DIE,DR,DIU,DIV,DIW

 +20       WRITE !

 +21       IF $DATA(Y)

               WRITE !!,"ERROR WHILE ATTEMPTING TO UPDATE PCC PROBLEM LIST!!"

 +22       KILL AMHNUMB,X,Y

 +23       QUIT 

XIT       ;

 +1        KILL DIADD,DLAYGO

 +2        KILL AMHTX,AMHTY,AMHNARR,AMHLEPT,AMHNUM,AMHPOV,AMHPOVP,AMHPOVR,AMHRPRO,AMHDT,AMHLOOK

 +3        QUIT 

EN        ;EP add to mhss problem list - screen man call

 +1       ;  new everthing except AMH*

           DO EN^XBNEW("EN1^AMHLEPOV","AMH*")

 +2        QUIT 

 +3       ;

EN1       ; ENTRY POINT FOR ^XBNEW

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        SET AMHDT=$PIECE(AMHDATE,".")

 +3        DO ADDBH

 +4        DO XIT

 +5        QUIT 

EN2       ;EP add to pcc problem list - screen man call

 +1        DO EN^XBNEW("EN3^AMHLEPOV","AMH*")

 +2        QUIT 

EN3       ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        SET AMHDT=$PIECE(AMHDATE,".")

 +3        IF '$$ASKPCC^AMHLEIN(DUZ(2))

               WRITE !!,"PARAMETER SET TO NO PCC PROBLEM LIST UPDATING",!

               HANG 5

               QUIT 

 +4        IF '$GET(AMHPAT)

               QUIT 

 +5        IF $PIECE(^AMHPROB(AMHPOVP,0),U,5)=""

               WRITE !!,"THIS PROBLEM CODE CANNOT BE ADDED TO A PCC PROBLEM LIST!!",!!

               HANG 5

               QUIT 

 +6        IF $PIECE(^AMHPROB(AMHPOVP,0),U,8)=1

               WRITE !!,"THIS PROBLEM CODE CANNOT BE ADDED TO A PCC PROBLEM LIST!!",!!

               HANG 5

               QUIT 

 +7        IF '$GET(AMHLOC)

               SET AMHLOC=$$GET^DDSVAL(9002011,AMHR,".04","I")

 +8        DO ADDPCC

 +9        QUIT