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
