ORQQPL2 ; ALB/PDR/REV - RPCs FOR CPRS GUI IMPLEMENTATION ;09:49 AM 29 Feb 2000
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10**;Dec 17, 1997
;
; -------------- GET HISTORY FOR DETAIL DISPLAY ----------------------
;
HIST(RETURN,GMPIFN) ; GET AUDIT HISTORY
; taken from EN^GMPLDISP
N IDT,AIFN,S,ORDT,TXT,I,L,GMPDT,LCNT
S LCNT=0
I '$D(^GMPL(125.8,"B",GMPIFN)) D Q ;BAIL OUT - NO CHANGES
. S RETURN(0)="NONE"
; get change history
S IDT=""
F S IDT=$O(^GMPL(125.8,"AD",GMPIFN,IDT)) Q:IDT'>0 D
. S AIFN=""
. F S AIFN=$O(^GMPL(125.8,"AD",GMPIFN,IDT,AIFN)) Q:AIFN'>0 D
.. D DT^GMPLHIST
; Transfer data and clean up for return to GUI
S S="",I=0,TXT=""
F S S=$O(GMPDT(S)) Q:S="" D
. S L=GMPDT(S,0)
. I $L(L,": ")>1 D Q ; does line begin with date? (hope ": " can't be part of text)
.. D FLUSH(.RETURN,.I)
.. S ORDT=$P(L,": ") ; get new date
.. S TXT=$$STRIP($P(L,": ",2,999)) ; start new text string
. S TXT=TXT_" "_$$STRIP(L) ; line does not begin with date, so add to existing text line
I '$D(RETURN(0)) S RETURN(0)=I
D FLUSH(.RETURN,.I)
Q
;
FLUSH(RETURN,I) ; FLUSH FORMATTED AUDIT STRING
I I'=0 D ; do we have a text string built?
. S RETURN(I)=$$STRIP(ORDT)_U_TXT ; return date and text
S I=I+1
Q
;
STRIP(VAL) ; STRIP LEADING SPACES FROM VALUES
N J
F J=1:1 Q:$E(VAL,J)'=" "
Q $E(VAL,J,9999)
;
; ------------------- DELETE A PROBLEM FROM LIST ---------------------
;
DELETE(RESULT,GMPIFN,GMPROV,GMPVAMC,REASON) ; DELETE A PROBLEM
; From GMPL1 - silent version
N CHNGE
I REASON'="" D
. S GMPFLD(10,"NEW",1)=REASON
. D NEWNOTE^GMPLSAVE
S CHNGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($H)
S CHNGE=CHNGE_U_DUZ_"^P^H^Deleted^"_+$G(GMPROV)
S $P(^AUPNPROB(GMPIFN,1),U,2)="H"
S RESULT=1
D AUDIT^GMPLX(CHNGE,"")
D DTMOD^GMPLX(GMPIFN)
K GMPFLD
Q
; ------------------ REPLACE REMOVED PROBLEM ----------------------
;
REPLACE(RETURN,DA) ; -- replace problem on patient's list
; taken from REPLACE^GMPLRPTR
N CHNGE,DIE,DR
I $P($G(^AUPNPROB(DA,1)),U,2)'="H" D Q ; BAIL OUT - INVALID RECORD
. S RETURN=0
S DR="1.02////P"
S DIE="^AUPNPROB("
D ^DIE
S CHNGE=DA_"^1.02^"_$$HTFM^XLFDT($H)_U_DUZ_"^H^P^Replaced^"_DUZ
D AUDIT^GMPLX(CHNGE,"")
D DTMOD^GMPLX(DA)
S RETURN=1
Q
;
; ------------------- VERIFY A PROBLEM ------------------------
;
VERIFY(RETURN,GMPIFN) ; -- verify a transcribed problem
; RETURN: ;(consistent with UPDATE function)
; SUCCESS:
; RETURN>0, RETURN(0)=""
; FAILURE:
; RETURN<0, RETURN(0)=verbose error message
N NOW,CHNGE
S NOW=$$HTFM^XLFDT($H)
I $P(^AUPNPROB(GMPIFN,1),U,2)'="T" D Q ; BAIL OUT - ALREADY VERIFIED
. S RETURN=-1
. S RETURN(0)="Problem Already Verified"
L +^AUPNPROB(GMPIFN,0):10
I '$T D Q ; BAIL OUT - NO LOCK
. S RETURN=-1
. S RETURN(0)="Record in use. Try again in a few moments"
S $P(^AUPNPROB(GMPIFN,1),U,2)="P"
S CHNGE=GMPIFN_"^1.02^"_NOW_U_DUZ_"^T^P^Verified^"_DUZ
D AUDIT^GMPLX(CHNGE,"")
D DTMOD^GMPLX(GMPIFN)
L -^AUPNPROB(GMPIFN,0)
S RETURN=1
S RETURN(0)=""
Q
INACT(RETURN,GMPIFN) ; -- inactivate a problem
; RETURN: ;(consistent with UPDATE function)
; SUCCESS:
; RETURN>0, RETURN(0)=""
; FAILURE:
; RETURN<0, RETURN(0)=verbose error message
N NOW,CHNGE
S NOW=$$HTFM^XLFDT($H)
I $P(^AUPNPROB(GMPIFN,0),U,12)'="A" D Q ; BAIL OUT - ALREADY INACTIVE
. S RETURN=-1
. S RETURN(0)="Problem Already Inactive"
L +^AUPNPROB(GMPIFN,0):10
I '$T D Q ; BAIL OUT - NO LOCK
. S RETURN=-1
. S RETURN(0)="Record in use. Try again in a few moments"
S $P(^AUPNPROB(GMPIFN,0),U,12)="I"
S CHNGE=GMPIFN_"^.12^"_NOW_U_DUZ_"^A^I^Inactivated^"_DUZ
D AUDIT^GMPLX(CHNGE,"")
D DTMOD^GMPLX(GMPIFN)
L -^AUPNPROB(GMPIFN,0)
S RETURN=1
S RETURN(0)=""
Q
OLDCOMM(ORY,PIFN) ; Return comments for a problem - SINGLE DIVISION!
;N FAC,NIFN,NOTE,NOTECNT
;S NOTECNT=0
;S FAC=$O(^AUPNPROB(PIFN,11,"B",+$G(DUZ(2)),0)) Q:'FAC
;F NIFN=0:0 S NIFN=$O(^AUPNPROB(PIFN,11,FAC,11,"B",NIFN)) Q:NIFN'>0 D
;. Q:$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,4)'="A"
;. S NOTE=$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,3)
;. S NOTECNT=NOTECNT+1,ORY(NOTECNT)=NOTE
Q
GETCOMM(ORY,PIFN) ; Return comments for a problem - MULTI-DIVISIONAL
N FAC,NIFN,NOTE,NOTECNT
S NOTECNT=0,FAC=0
F S FAC=$O(^AUPNPROB(PIFN,11,FAC)) Q:+FAC'>0 D
. S NIFN=0
. F S NIFN=$O(^AUPNPROB(PIFN,11,FAC,11,NIFN)) Q:NIFN'>0 D
. . Q:$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,4)'="A"
. . S NOTE=$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,3)
. . S NOTECNT=NOTECNT+1,ORY(NOTECNT)=NOTE
Q
SAVEVIEW(Y,GMPLVIEW) ; -- save new view in File #200/Field #125
N TMP
Q:'$D(GMPLVIEW)
S TMP=$P($G(^VA(200,DUZ,125)),U,2,999)
S ^VA(200,DUZ,125)=$P(GMPLVIEW,U,1)_U_TMP
S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1)
I TMP'="" D Q
. D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1,$P(GMPLVIEW,U,2))
D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1,$P(GMPLVIEW,U,2))
Q
;
ORQQPL2 ; ALB/PDR/REV - RPCs FOR CPRS GUI IMPLEMENTATION ;09:49 AM 29 Feb 2000
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10**;Dec 17, 1997
+2 ;
+3 ; -------------- GET HISTORY FOR DETAIL DISPLAY ----------------------
+4 ;
HIST(RETURN,GMPIFN) ; GET AUDIT HISTORY
+1 ; taken from EN^GMPLDISP
+2 NEW IDT,AIFN,S,ORDT,TXT,I,L,GMPDT,LCNT
+3 SET LCNT=0
+4 ;BAIL OUT - NO CHANGES
IF '$DATA(^GMPL(125.8,"B",GMPIFN))
Begin DoDot:1
+5 SET RETURN(0)="NONE"
End DoDot:1
QUIT
+6 ; get change history
+7 SET IDT=""
+8 FOR
SET IDT=$ORDER(^GMPL(125.8,"AD",GMPIFN,IDT))
IF IDT'>0
QUIT
Begin DoDot:1
+9 SET AIFN=""
+10 FOR
SET AIFN=$ORDER(^GMPL(125.8,"AD",GMPIFN,IDT,AIFN))
IF AIFN'>0
QUIT
Begin DoDot:2
+11 DO DT^GMPLHIST
End DoDot:2
End DoDot:1
+12 ; Transfer data and clean up for return to GUI
+13 SET S=""
SET I=0
SET TXT=""
+14 FOR
SET S=$ORDER(GMPDT(S))
IF S=""
QUIT
Begin DoDot:1
+15 SET L=GMPDT(S,0)
+16 ; does line begin with date? (hope ": " can't be part of text)
IF $LENGTH(L,": ")>1
Begin DoDot:2
+17 DO FLUSH(.RETURN,.I)
+18 ; get new date
SET ORDT=$PIECE(L,": ")
+19 ; start new text string
SET TXT=$$STRIP($PIECE(L,": ",2,999))
End DoDot:2
QUIT
+20 ; line does not begin with date, so add to existing text line
SET TXT=TXT_" "_$$STRIP(L)
End DoDot:1
+21 IF '$DATA(RETURN(0))
SET RETURN(0)=I
+22 DO FLUSH(.RETURN,.I)
+23 QUIT
+24 ;
FLUSH(RETURN,I) ; FLUSH FORMATTED AUDIT STRING
+1 ; do we have a text string built?
IF I'=0
Begin DoDot:1
+2 ; return date and text
SET RETURN(I)=$$STRIP(ORDT)_U_TXT
End DoDot:1
+3 SET I=I+1
+4 QUIT
+5 ;
STRIP(VAL) ; STRIP LEADING SPACES FROM VALUES
+1 NEW J
+2 FOR J=1:1
IF $EXTRACT(VAL,J)'=" "
QUIT
+3 QUIT $EXTRACT(VAL,J,9999)
+4 ;
+5 ; ------------------- DELETE A PROBLEM FROM LIST ---------------------
+6 ;
DELETE(RESULT,GMPIFN,GMPROV,GMPVAMC,REASON) ; DELETE A PROBLEM
+1 ; From GMPL1 - silent version
+2 NEW CHNGE
+3 IF REASON'=""
Begin DoDot:1
+4 SET GMPFLD(10,"NEW",1)=REASON
+5 DO NEWNOTE^GMPLSAVE
End DoDot:1
+6 SET CHNGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($HOROLOG)
+7 SET CHNGE=CHNGE_U_DUZ_"^P^H^Deleted^"_+$GET(GMPROV)
+8 SET $PIECE(^AUPNPROB(GMPIFN,1),U,2)="H"
+9 SET RESULT=1
+10 DO AUDIT^GMPLX(CHNGE,"")
+11 DO DTMOD^GMPLX(GMPIFN)
+12 KILL GMPFLD
+13 QUIT
+14 ; ------------------ REPLACE REMOVED PROBLEM ----------------------
+15 ;
REPLACE(RETURN,DA) ; -- replace problem on patient's list
+1 ; taken from REPLACE^GMPLRPTR
+2 NEW CHNGE,DIE,DR
+3 ; BAIL OUT - INVALID RECORD
IF $PIECE($GET(^AUPNPROB(DA,1)),U,2)'="H"
Begin DoDot:1
+4 SET RETURN=0
End DoDot:1
QUIT
+5 SET DR="1.02////P"
+6 SET DIE="^AUPNPROB("
+7 DO ^DIE
+8 SET CHNGE=DA_"^1.02^"_$$HTFM^XLFDT($HOROLOG)_U_DUZ_"^H^P^Replaced^"_DUZ
+9 DO AUDIT^GMPLX(CHNGE,"")
+10 DO DTMOD^GMPLX(DA)
+11 SET RETURN=1
+12 QUIT
+13 ;
+14 ; ------------------- VERIFY A PROBLEM ------------------------
+15 ;
VERIFY(RETURN,GMPIFN) ; -- verify a transcribed problem
+1 ; RETURN: ;(consistent with UPDATE function)
+2 ; SUCCESS:
+3 ; RETURN>0, RETURN(0)=""
+4 ; FAILURE:
+5 ; RETURN<0, RETURN(0)=verbose error message
+6 NEW NOW,CHNGE
+7 SET NOW=$$HTFM^XLFDT($HOROLOG)
+8 ; BAIL OUT - ALREADY VERIFIED
IF $PIECE(^AUPNPROB(GMPIFN,1),U,2)'="T"
Begin DoDot:1
+9 SET RETURN=-1
+10 SET RETURN(0)="Problem Already Verified"
End DoDot:1
QUIT
+11 LOCK +^AUPNPROB(GMPIFN,0):10
+12 ; BAIL OUT - NO LOCK
IF '$TEST
Begin DoDot:1
+13 SET RETURN=-1
+14 SET RETURN(0)="Record in use. Try again in a few moments"
End DoDot:1
QUIT
+15 SET $PIECE(^AUPNPROB(GMPIFN,1),U,2)="P"
+16 SET CHNGE=GMPIFN_"^1.02^"_NOW_U_DUZ_"^T^P^Verified^"_DUZ
+17 DO AUDIT^GMPLX(CHNGE,"")
+18 DO DTMOD^GMPLX(GMPIFN)
+19 LOCK -^AUPNPROB(GMPIFN,0)
+20 SET RETURN=1
+21 SET RETURN(0)=""
+22 QUIT
INACT(RETURN,GMPIFN) ; -- inactivate a problem
+1 ; RETURN: ;(consistent with UPDATE function)
+2 ; SUCCESS:
+3 ; RETURN>0, RETURN(0)=""
+4 ; FAILURE:
+5 ; RETURN<0, RETURN(0)=verbose error message
+6 NEW NOW,CHNGE
+7 SET NOW=$$HTFM^XLFDT($HOROLOG)
+8 ; BAIL OUT - ALREADY INACTIVE
IF $PIECE(^AUPNPROB(GMPIFN,0),U,12)'="A"
Begin DoDot:1
+9 SET RETURN=-1
+10 SET RETURN(0)="Problem Already Inactive"
End DoDot:1
QUIT
+11 LOCK +^AUPNPROB(GMPIFN,0):10
+12 ; BAIL OUT - NO LOCK
IF '$TEST
Begin DoDot:1
+13 SET RETURN=-1
+14 SET RETURN(0)="Record in use. Try again in a few moments"
End DoDot:1
QUIT
+15 SET $PIECE(^AUPNPROB(GMPIFN,0),U,12)="I"
+16 SET CHNGE=GMPIFN_"^.12^"_NOW_U_DUZ_"^A^I^Inactivated^"_DUZ
+17 DO AUDIT^GMPLX(CHNGE,"")
+18 DO DTMOD^GMPLX(GMPIFN)
+19 LOCK -^AUPNPROB(GMPIFN,0)
+20 SET RETURN=1
+21 SET RETURN(0)=""
+22 QUIT
OLDCOMM(ORY,PIFN) ; Return comments for a problem - SINGLE DIVISION!
+1 ;N FAC,NIFN,NOTE,NOTECNT
+2 ;S NOTECNT=0
+3 ;S FAC=$O(^AUPNPROB(PIFN,11,"B",+$G(DUZ(2)),0)) Q:'FAC
+4 ;F NIFN=0:0 S NIFN=$O(^AUPNPROB(PIFN,11,FAC,11,"B",NIFN)) Q:NIFN'>0 D
+5 ;. Q:$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,4)'="A"
+6 ;. S NOTE=$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,3)
+7 ;. S NOTECNT=NOTECNT+1,ORY(NOTECNT)=NOTE
+8 QUIT
GETCOMM(ORY,PIFN) ; Return comments for a problem - MULTI-DIVISIONAL
+1 NEW FAC,NIFN,NOTE,NOTECNT
+2 SET NOTECNT=0
SET FAC=0
+3 FOR
SET FAC=$ORDER(^AUPNPROB(PIFN,11,FAC))
IF +FAC'>0
QUIT
Begin DoDot:1
+4 SET NIFN=0
+5 FOR
SET NIFN=$ORDER(^AUPNPROB(PIFN,11,FAC,11,NIFN))
IF NIFN'>0
QUIT
Begin DoDot:2
+6 IF $PIECE($GET(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,4)'="A"
QUIT
+7 SET NOTE=$PIECE($GET(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,3)
+8 SET NOTECNT=NOTECNT+1
SET ORY(NOTECNT)=NOTE
End DoDot:2
End DoDot:1
+9 QUIT
SAVEVIEW(Y,GMPLVIEW) ; -- save new view in File #200/Field #125
+1 NEW TMP
+2 IF '$DATA(GMPLVIEW)
QUIT
+3 SET TMP=$PIECE($GET(^VA(200,DUZ,125)),U,2,999)
+4 SET ^VA(200,DUZ,125)=$PIECE(GMPLVIEW,U,1)_U_TMP
+5 SET TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1)
+6 IF TMP'=""
Begin DoDot:1
+7 DO CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1,$PIECE(GMPLVIEW,U,2))
End DoDot:1
QUIT
+8 DO ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1,$PIECE(GMPLVIEW,U,2))
+9 QUIT
+10 ;
