AMHAPRB ; IHS/CMI/LAB - PROMPT FOR PROBLEM ;
;;4.0;IHS BEHAVIORAL HEALTH;**2,4**;JUN 18, 2010;Build 28
;
PLUDE(AMHPRBI,AMHP,AMHV,AMHD,AMHTPRD) ;EP - called from data entry input templates
;
D EN^XBNEW("PLUDE1^AMHAPRB","AMHP;AMHV;AMHD;AMHPRBI;AMHTPRD")
Q
PLUDE1 ;EP - called from xbnew
;get date pl updated
I $G(AMHD)="" S AMHD=$P(^AMHREC(AMHV,0),U,1)
S DIR(0)="D^::EPTSX",DIR("A")="Enter the Date the Problem List was Updated by the Provider"
S DIR("B")=$$FMTE^XLFDT(DT),DIR("?")="This is the visit date or the date the provider updated the problem list."
KILL DA D ^DIR KILL DIR
I $D(DIRUT) W !!,"This is required." G PLUDE1
I $P(Y,".")>DT W !!,"Future Dates now allowed.",! G PLUDE1
S AMHD=Y
PLUDE1P ;GET PROVIDER
S DIR(0)="9002011.14,1204",DIR("A")="Enter the individual that updated the Problem List"
S DIR("A",1)="Enter the individual that updated the Problem List. If you are"
S DIR("A",2)="transcribing an update from a BHS provider, then enter the name"
S DIR("A",3)="of the provider. If you are a data entry/coder correcting the"
S DIR("A",4)="Problem List (for instance, correcting the diagnosis code) then enter your"
S DIR("A",5)="own name."
S DIR("B")=$S($G(AMHV):$$PRIMPROV^AMHUTIL(AMHV,"N"),1:"") KILL DA D ^DIR KILL DIR
I $D(DIRUT) W !!,"This is required." G PLUDE1P
S AMHPRV=+Y
D PLU($G(AMHPRBI),AMHV,AMHP,AMHD,AMHPRV,.AMHRET)
I $P(AMHRET,U,1)=0 W !!,"error: ",$P(AMHRET,U,2)
Q
PLU(AMHPIEN,AMHV,AMHP,AMHD,AMHPRV,RETVAL) ;PEP - called to update Problem list update fields
;this API can be called to have a V UPDATED/REVIEWED entry and populate the
;.11, .12, and .13 fields
;input: AMHPIEN - ien of problem list entry
; AMHV - ien of RECORD, if in the context of a visit
; AMHP - DFN
; AMHD - Date and optionally time of problem list update (fileman format)
; AMHPRV = ien of provider updating the problem list
;this API will create a new V UPDATED/REVIEWED entry if there isn't currently one
;for Provider AMHP on date AMHD
;if not in the context of a visit (AMHV = null) then an event visit will be created
;with a V UPDATED/REVIEWED v file entry
;
;RETURN VALUE:
; ien of V UPDATED/REVIEWED entry that was created
; or 0^error message
S AMHPIEN=$G(AMHPIEN)
S AMHV=$G(AMHV)
S AMHP=$G(AMHP)
I 'AMHP S RETVAL="0^not a valid patient DFN" Q
I '$D(^AUPNPAT(AMHP,0)) S RETVAL="0^not a valid patient DFN" Q
S AMHD=$G(AMHD)
I 'AMHD S RETVAL="0^no valid date passed" Q
S AMHPRV=$G(AMHPRV)
I 'AMHPRV S RETVAL="0^no valid provider ien passed" Q
S RETVAL=""
;
I AMHV D PLUV Q
Q
PLUV ;have a visit so create a v updated/reviewed for provider AMHPRV if one does
;not exist on this visit already.
NEW AMHX,AMHVD,AMHVRI,AMHVAL
S AMHVAL=$O(^AUTTCRA("C","PLU",0))
I AMHVAL="" S RETVAL="0^action item missing" Q
S AMHVRI=""
S AMHX=0 F S AMHX=$O(^AMHRRUP("AD",AMHV,AMHX)) Q:AMHX=""!(AMHVRI) D
.;is this entry a problem list review entry?
.Q:$P(^AMHRRUP(AMHX,0),U,1)'=AMHVAL ;this one isn't a PLU entry
.Q:$P($G(^AMHRRUP(AMHX,2)),U,1)
.Q:$P($G(^AMHRRUP(AMHX,12)),U,4)'=AMHPRV ;not this provider
.S AMHVRI=AMHX ;found one so don't create one
.Q
I AMHVRI S RETVAL=AMHVRI Q
;create MHSS UPDATED/REVIEWED entry
S DIC="^AMHRRUP(",X=AMHVAL,DIC("DR")=".02////"_AMHP_";.03////"_AMHV_";1201////"_AMHD_";1204////"_AMHPRV,DIADD=1,DLAYGO=9002011.14,DIC(0)="EL"
D FILE^DICN
K DLAYGO,DIADD,DIC,DA
Q
ANYACTP(P,EDATE) ;EP - does this patient have any active problems?
I '$G(P) Q 0
S EDATE=$G(EDATE)
NEW X,Y,Z
S Z=0
S X=0 F S X=$O(^AMHPPROB("AC",P,X)) Q:X'=+X!(Z) D
.Q:'$D(^AMHPPROB(X,0))
.Q:$P(^AMHPPROB(X,0),U,12)'="A"
.I EDATE,$P(^AMHPPROB(X,0),U,8)>EDATE Q
.S Z=1
.Q
Q Z
PLUPCC(AMHREC,AMHPIEN,AMHP) ;EP
I '$G(AMHREC) Q
I '$D(^AMHREC(AMHREC,0)) Q
NEW AMHV,DIE,DA,DR
S AMHV=$P(^AMHREC(AMHREC,0),U,16)
;set field to let link know to create PCC V Updated/Reviewed entry that PCC PL was updated by BH provider
S DA=AMHREC,DIE="^AMHREC(",DR="1801///"_$P(^AMHREC(AMHREC,0),U,1)_";1802////"_AMHP D ^DIE K DIE,DA,DR
I 'AMHV Q ;No pcc visit yet, it will get updated later
;create V updated/reviewed and attach it to the pcc visit. call pcc routines
NEW AMHVAL S AMHVAL=""
D PLU^APCDAPRB($G(AMHPIEN),AMHV,$P(^AMHREC(AMHREC,0),U,8),$P(^AMHREC(AMHREC,0),U,1),$S(AMHP:AMHP,1:DUZ),.AMHVAL)
Q
;
PLRPCC(AMHREC,AMHD,AMHPROV) ;EP
I '$G(AMHREC) Q
I '$D(^AMHREC(AMHREC,0)) Q
NEW AMHV,DIE,DA,DR
S AMHV=$P(^AMHREC(AMHREC,0),U,16)
;set field to let link know to create PCC V Updated/Reviewed entry that PCC PL was updated by BH provider
S DA=AMHREC,DIE="^AMHREC(",DR="1803///"_$P(^AMHREC(AMHREC,0),U,1)_";1804////"_AMHPROV D ^DIE K DIE,DA,DR
I 'AMHV Q ;No pcc visit yet, it will get updated later
;create V updated/reviewed and attach it to the pcc visit. call pcc routines
NEW AMHVAL S AMHVAL=""
D PLRADD^APCDPL1(AMHV,$P(^AMHREC(AMHREC,0),U,8),$P(^AMHREC(AMHREC,0),U,1),$S(AMHPROV:AMHPROV,1:DUZ),.AMHVAL)
Q
;
NAPPCC(AMHREC,AMHD,AMHPROV) ;EP
I '$G(AMHREC) Q
I '$D(^AMHREC(AMHREC,0)) Q
NEW AMHV,DIE,DA,DR
S AMHV=$P(^AMHREC(AMHREC,0),U,16)
;set field to let link know to create PCC V Updated/Reviewed entry that PCC PL was updated by BH provider
S DA=AMHREC,DIE="^AMHREC(",DR="1805///"_$P(^AMHREC(AMHREC,0),U,1)_";1806////"_AMHPROV D ^DIE K DIE,DA,DR
I 'AMHV Q ;No pcc visit yet, it will get updated later
;create V updated/reviewed and attach it to the pcc visit. call pcc routines
NEW AMHVAL S AMHVAL=""
D NAPADD^APCDPL1(AMHV,$P(^AMHREC(AMHREC,0),U,8),$P(^AMHREC(AMHREC,0),U,1),$S(AMHPROV:AMHPROV,1:DUZ),.AMHVAL)
Q
AMHAPRB ; IHS/CMI/LAB - PROMPT FOR PROBLEM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**2,4**;JUN 18, 2010;Build 28
+2 ;
PLUDE(AMHPRBI,AMHP,AMHV,AMHD,AMHTPRD) ;EP - called from data entry input templates
+1 ;
+2 DO EN^XBNEW("PLUDE1^AMHAPRB","AMHP;AMHV;AMHD;AMHPRBI;AMHTPRD")
+3 QUIT
PLUDE1 ;EP - called from xbnew
+1 ;get date pl updated
+2 IF $GET(AMHD)=""
SET AMHD=$PIECE(^AMHREC(AMHV,0),U,1)
+3 SET DIR(0)="D^::EPTSX"
SET DIR("A")="Enter the Date the Problem List was Updated by the Provider"
+4 SET DIR("B")=$$FMTE^XLFDT(DT)
SET DIR("?")="This is the visit date or the date the provider updated the problem list."
+5 KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
WRITE !!,"This is required."
GOTO PLUDE1
+7 IF $PIECE(Y,".")>DT
WRITE !!,"Future Dates now allowed.",!
GOTO PLUDE1
+8 SET AMHD=Y
PLUDE1P ;GET PROVIDER
+1 SET DIR(0)="9002011.14,1204"
SET DIR("A")="Enter the individual that updated the Problem List"
+2 SET DIR("A",1)="Enter the individual that updated the Problem List. If you are"
+3 SET DIR("A",2)="transcribing an update from a BHS provider, then enter the name"
+4 SET DIR("A",3)="of the provider. If you are a data entry/coder correcting the"
+5 SET DIR("A",4)="Problem List (for instance, correcting the diagnosis code) then enter your"
+6 SET DIR("A",5)="own name."
+7 SET DIR("B")=$SELECT($GET(AMHV):$$PRIMPROV^AMHUTIL(AMHV,"N"),1:"")
KILL DA
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
WRITE !!,"This is required."
GOTO PLUDE1P
+9 SET AMHPRV=+Y
+10 DO PLU($GET(AMHPRBI),AMHV,AMHP,AMHD,AMHPRV,.AMHRET)
+11 IF $PIECE(AMHRET,U,1)=0
WRITE !!,"error: ",$PIECE(AMHRET,U,2)
+12 QUIT
PLU(AMHPIEN,AMHV,AMHP,AMHD,AMHPRV,RETVAL) ;PEP - called to update Problem list update fields
+1 ;this API can be called to have a V UPDATED/REVIEWED entry and populate the
+2 ;.11, .12, and .13 fields
+3 ;input: AMHPIEN - ien of problem list entry
+4 ; AMHV - ien of RECORD, if in the context of a visit
+5 ; AMHP - DFN
+6 ; AMHD - Date and optionally time of problem list update (fileman format)
+7 ; AMHPRV = ien of provider updating the problem list
+8 ;this API will create a new V UPDATED/REVIEWED entry if there isn't currently one
+9 ;for Provider AMHP on date AMHD
+10 ;if not in the context of a visit (AMHV = null) then an event visit will be created
+11 ;with a V UPDATED/REVIEWED v file entry
+12 ;
+13 ;RETURN VALUE:
+14 ; ien of V UPDATED/REVIEWED entry that was created
+15 ; or 0^error message
+16 SET AMHPIEN=$GET(AMHPIEN)
+17 SET AMHV=$GET(AMHV)
+18 SET AMHP=$GET(AMHP)
+19 IF 'AMHP
SET RETVAL="0^not a valid patient DFN"
QUIT
+20 IF '$DATA(^AUPNPAT(AMHP,0))
SET RETVAL="0^not a valid patient DFN"
QUIT
+21 SET AMHD=$GET(AMHD)
+22 IF 'AMHD
SET RETVAL="0^no valid date passed"
QUIT
+23 SET AMHPRV=$GET(AMHPRV)
+24 IF 'AMHPRV
SET RETVAL="0^no valid provider ien passed"
QUIT
+25 SET RETVAL=""
+26 ;
+27 IF AMHV
DO PLUV
QUIT
+28 QUIT
PLUV ;have a visit so create a v updated/reviewed for provider AMHPRV if one does
+1 ;not exist on this visit already.
+2 NEW AMHX,AMHVD,AMHVRI,AMHVAL
+3 SET AMHVAL=$ORDER(^AUTTCRA("C","PLU",0))
+4 IF AMHVAL=""
SET RETVAL="0^action item missing"
QUIT
+5 SET AMHVRI=""
+6 SET AMHX=0
FOR
SET AMHX=$ORDER(^AMHRRUP("AD",AMHV,AMHX))
IF AMHX=""!(AMHVRI)
QUIT
Begin DoDot:1
+7 ;is this entry a problem list review entry?
+8 ;this one isn't a PLU entry
IF $PIECE(^AMHRRUP(AMHX,0),U,1)'=AMHVAL
QUIT
+9 IF $PIECE($GET(^AMHRRUP(AMHX,2)),U,1)
QUIT
+10 ;not this provider
IF $PIECE($GET(^AMHRRUP(AMHX,12)),U,4)'=AMHPRV
QUIT
+11 ;found one so don't create one
SET AMHVRI=AMHX
+12 QUIT
End DoDot:1
+13 IF AMHVRI
SET RETVAL=AMHVRI
QUIT
+14 ;create MHSS UPDATED/REVIEWED entry
+15 SET DIC="^AMHRRUP("
SET X=AMHVAL
SET DIC("DR")=".02////"_AMHP_";.03////"_AMHV_";1201////"_AMHD_";1204////"_AMHPRV
SET DIADD=1
SET DLAYGO=9002011.14
SET DIC(0)="EL"
+16 DO FILE^DICN
+17 KILL DLAYGO,DIADD,DIC,DA
+18 QUIT
ANYACTP(P,EDATE) ;EP - does this patient have any active problems?
+1 IF '$GET(P)
QUIT 0
+2 SET EDATE=$GET(EDATE)
+3 NEW X,Y,Z
+4 SET Z=0
+5 SET X=0
FOR
SET X=$ORDER(^AMHPPROB("AC",P,X))
IF X'=+X!(Z)
QUIT
Begin DoDot:1
+6 IF '$DATA(^AMHPPROB(X,0))
QUIT
+7 IF $PIECE(^AMHPPROB(X,0),U,12)'="A"
QUIT
+8 IF EDATE
IF $PIECE(^AMHPPROB(X,0),U,8)>EDATE
QUIT
+9 SET Z=1
+10 QUIT
End DoDot:1
+11 QUIT Z
PLUPCC(AMHREC,AMHPIEN,AMHP) ;EP
+1 IF '$GET(AMHREC)
QUIT
+2 IF '$DATA(^AMHREC(AMHREC,0))
QUIT
+3 NEW AMHV,DIE,DA,DR
+4 SET AMHV=$PIECE(^AMHREC(AMHREC,0),U,16)
+5 ;set field to let link know to create PCC V Updated/Reviewed entry that PCC PL was updated by BH provider
+6 SET DA=AMHREC
SET DIE="^AMHREC("
SET DR="1801///"_$PIECE(^AMHREC(AMHREC,0),U,1)_";1802////"_AMHP
DO ^DIE
KILL DIE,DA,DR
+7 ;No pcc visit yet, it will get updated later
IF 'AMHV
QUIT
+8 ;create V updated/reviewed and attach it to the pcc visit. call pcc routines
+9 NEW AMHVAL
SET AMHVAL=""
+10 DO PLU^APCDAPRB($GET(AMHPIEN),AMHV,$PIECE(^AMHREC(AMHREC,0),U,8),$PIECE(^AMHREC(AMHREC,0),U,1),$SELECT(AMHP:AMHP,1:DUZ),.AMHVAL)
+11 QUIT
+12 ;
PLRPCC(AMHREC,AMHD,AMHPROV) ;EP
+1 IF '$GET(AMHREC)
QUIT
+2 IF '$DATA(^AMHREC(AMHREC,0))
QUIT
+3 NEW AMHV,DIE,DA,DR
+4 SET AMHV=$PIECE(^AMHREC(AMHREC,0),U,16)
+5 ;set field to let link know to create PCC V Updated/Reviewed entry that PCC PL was updated by BH provider
+6 SET DA=AMHREC
SET DIE="^AMHREC("
SET DR="1803///"_$PIECE(^AMHREC(AMHREC,0),U,1)_";1804////"_AMHPROV
DO ^DIE
KILL DIE,DA,DR
+7 ;No pcc visit yet, it will get updated later
IF 'AMHV
QUIT
+8 ;create V updated/reviewed and attach it to the pcc visit. call pcc routines
+9 NEW AMHVAL
SET AMHVAL=""
+10 DO PLRADD^APCDPL1(AMHV,$PIECE(^AMHREC(AMHREC,0),U,8),$PIECE(^AMHREC(AMHREC,0),U,1),$SELECT(AMHPROV:AMHPROV,1:DUZ),.AMHVAL)
+11 QUIT
+12 ;
NAPPCC(AMHREC,AMHD,AMHPROV) ;EP
+1 IF '$GET(AMHREC)
QUIT
+2 IF '$DATA(^AMHREC(AMHREC,0))
QUIT
+3 NEW AMHV,DIE,DA,DR
+4 SET AMHV=$PIECE(^AMHREC(AMHREC,0),U,16)
+5 ;set field to let link know to create PCC V Updated/Reviewed entry that PCC PL was updated by BH provider
+6 SET DA=AMHREC
SET DIE="^AMHREC("
SET DR="1805///"_$PIECE(^AMHREC(AMHREC,0),U,1)_";1806////"_AMHPROV
DO ^DIE
KILL DIE,DA,DR
+7 ;No pcc visit yet, it will get updated later
IF 'AMHV
QUIT
+8 ;create V updated/reviewed and attach it to the pcc visit. call pcc routines
+9 NEW AMHVAL
SET AMHVAL=""
+10 DO NAPADD^APCDPL1(AMHV,$PIECE(^AMHREC(AMHREC,0),U,8),$PIECE(^AMHREC(AMHREC,0),U,1),$SELECT(AMHPROV:AMHPROV,1:DUZ),.AMHVAL)
+11 QUIT
