Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORQQPL2

ORQQPL2.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; -------------- GET HISTORY FOR DETAIL DISPLAY ----------------------
  1.  ;
  1. HIST(RETURN,GMPIFN) ; GET AUDIT HISTORY
  1.  ; taken from EN^GMPLDISP
  1.  N IDT,AIFN,S,ORDT,TXT,I,L,GMPDT,LCNT
  1.  S LCNT=0
  1.  I '$D(^GMPL(125.8,"B",GMPIFN)) D  Q  ;BAIL OUT - NO CHANGES
  1.  . S RETURN(0)="NONE"
  1.  ;       get change history
  1.  S IDT=""
  1.  F  S IDT=$O(^GMPL(125.8,"AD",GMPIFN,IDT)) Q:IDT'>0  D
  1.  . S AIFN=""
  1.  . F  S AIFN=$O(^GMPL(125.8,"AD",GMPIFN,IDT,AIFN)) Q:AIFN'>0  D
  1.  .. D DT^GMPLHIST
  1.  ;         Transfer data and clean up for return to GUI
  1.  S S="",I=0,TXT=""
  1.  F  S S=$O(GMPDT(S)) Q:S=""  D
  1.  . S L=GMPDT(S,0)
  1.  . I $L(L,": ")>1 D  Q  ; does line begin with date? (hope ": " can't be part of text)
  1.  .. D FLUSH(.RETURN,.I)
  1.  .. S ORDT=$P(L,": ") ; get new date
  1.  .. S TXT=$$STRIP($P(L,": ",2,999)) ; start new text string
  1.  . S TXT=TXT_" "_$$STRIP(L)  ; line does not begin with date, so add to existing text line
  1.  I '$D(RETURN(0)) S RETURN(0)=I
  1.  D FLUSH(.RETURN,.I)
  1.  Q 
  1.  ;
  1. FLUSH(RETURN,I) ; FLUSH FORMATTED AUDIT STRING
  1.   I I'=0 D  ; do we have a text string built?
  1.  . S RETURN(I)=$$STRIP(ORDT)_U_TXT  ; return date and text
  1.   S I=I+1
  1.  Q
  1.  ;
  1. STRIP(VAL) ; STRIP LEADING SPACES FROM VALUES
  1.  N J
  1.  F J=1:1 Q:$E(VAL,J)'=" "
  1.  Q $E(VAL,J,9999)
  1.  ;
  1.  ; ------------------- DELETE A PROBLEM FROM LIST ---------------------
  1.  ;
  1. DELETE(RESULT,GMPIFN,GMPROV,GMPVAMC,REASON) ; DELETE A PROBLEM
  1.  ; From GMPL1 - silent version
  1.  N CHNGE
  1.  I REASON'="" D
  1.  . S GMPFLD(10,"NEW",1)=REASON
  1.  . D NEWNOTE^GMPLSAVE
  1.  S CHNGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($H)
  1.  S CHNGE=CHNGE_U_DUZ_"^P^H^Deleted^"_+$G(GMPROV)
  1.  S $P(^AUPNPROB(GMPIFN,1),U,2)="H"
  1.  S RESULT=1
  1.  D AUDIT^GMPLX(CHNGE,"")
  1.  D DTMOD^GMPLX(GMPIFN)
  1.  K GMPFLD
  1.  Q
  1.  ; ------------------ REPLACE REMOVED PROBLEM ----------------------
  1.  ;
  1. REPLACE(RETURN,DA) ; -- replace problem on patient's list
  1.  ; taken from REPLACE^GMPLRPTR
  1.  N CHNGE,DIE,DR
  1.  I $P($G(^AUPNPROB(DA,1)),U,2)'="H" D  Q  ; BAIL OUT - INVALID RECORD
  1.  . S RETURN=0
  1.  S DR="1.02////P"
  1.  S DIE="^AUPNPROB("
  1.  D ^DIE
  1.  S CHNGE=DA_"^1.02^"_$$HTFM^XLFDT($H)_U_DUZ_"^H^P^Replaced^"_DUZ
  1.  D AUDIT^GMPLX(CHNGE,"")
  1.  D DTMOD^GMPLX(DA)
  1.  S RETURN=1
  1.  Q
  1.  ;
  1.  ; -------------------  VERIFY A PROBLEM ------------------------
  1.  ;
  1. VERIFY(RETURN,GMPIFN) ; -- verify a transcribed problem
  1.  ; RETURN:  ;(consistent with UPDATE function)
  1.  ;   SUCCESS:
  1.  ;     RETURN>0, RETURN(0)=""
  1.  ;   FAILURE:
  1.  ;      RETURN<0, RETURN(0)=verbose error message
  1.  N NOW,CHNGE
  1.  S NOW=$$HTFM^XLFDT($H)
  1.  I $P(^AUPNPROB(GMPIFN,1),U,2)'="T" D  Q  ; BAIL OUT - ALREADY VERIFIED
  1.  . S RETURN=-1
  1.  . S RETURN(0)="Problem Already Verified"
  1.  L +^AUPNPROB(GMPIFN,0):10
  1.  I '$T D  Q  ; BAIL OUT - NO LOCK
  1.  . S RETURN=-1
  1.  . S RETURN(0)="Record in use. Try again in a few moments"
  1.  S $P(^AUPNPROB(GMPIFN,1),U,2)="P"
  1.  S CHNGE=GMPIFN_"^1.02^"_NOW_U_DUZ_"^T^P^Verified^"_DUZ
  1.  D AUDIT^GMPLX(CHNGE,"")
  1.  D DTMOD^GMPLX(GMPIFN)
  1.  L -^AUPNPROB(GMPIFN,0)
  1.  S RETURN=1
  1.  S RETURN(0)=""
  1.  Q
  1. INACT(RETURN,GMPIFN) ; -- inactivate a problem
  1.  ; RETURN:  ;(consistent with UPDATE function)
  1.  ;   SUCCESS:
  1.  ;     RETURN>0, RETURN(0)=""
  1.  ;   FAILURE:
  1.  ;      RETURN<0, RETURN(0)=verbose error message
  1.  N NOW,CHNGE
  1.  S NOW=$$HTFM^XLFDT($H)
  1.  I $P(^AUPNPROB(GMPIFN,0),U,12)'="A" D  Q  ; BAIL OUT - ALREADY INACTIVE
  1.  . S RETURN=-1
  1.  . S RETURN(0)="Problem Already Inactive"
  1.  L +^AUPNPROB(GMPIFN,0):10
  1.  I '$T D  Q  ; BAIL OUT - NO LOCK
  1.  . S RETURN=-1
  1.  . S RETURN(0)="Record in use. Try again in a few moments"
  1.  S $P(^AUPNPROB(GMPIFN,0),U,12)="I"
  1.  S CHNGE=GMPIFN_"^.12^"_NOW_U_DUZ_"^A^I^Inactivated^"_DUZ
  1.  D AUDIT^GMPLX(CHNGE,"")
  1.  D DTMOD^GMPLX(GMPIFN)
  1.  L -^AUPNPROB(GMPIFN,0)
  1.  S RETURN=1
  1.  S RETURN(0)=""
  1.  Q
  1. OLDCOMM(ORY,PIFN) ; Return comments for a problem - SINGLE DIVISION!
  1.  ;N FAC,NIFN,NOTE,NOTECNT
  1.  ;S NOTECNT=0
  1.  ;S FAC=$O(^AUPNPROB(PIFN,11,"B",+$G(DUZ(2)),0)) Q:'FAC
  1.  ;F NIFN=0:0 S NIFN=$O(^AUPNPROB(PIFN,11,FAC,11,"B",NIFN)) Q:NIFN'>0  D
  1.  ;. Q:$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,4)'="A"
  1.  ;. S NOTE=$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,3)
  1.  ;. S NOTECNT=NOTECNT+1,ORY(NOTECNT)=NOTE
  1.  Q
  1. GETCOMM(ORY,PIFN)       ; Return comments for a problem - MULTI-DIVISIONAL
  1.  N FAC,NIFN,NOTE,NOTECNT
  1.  S NOTECNT=0,FAC=0
  1.  F  S FAC=$O(^AUPNPROB(PIFN,11,FAC)) Q:+FAC'>0  D
  1.  . S NIFN=0
  1.  . F  S NIFN=$O(^AUPNPROB(PIFN,11,FAC,11,NIFN)) Q:NIFN'>0  D
  1.  . . Q:$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,4)'="A"
  1.  . . S NOTE=$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,3)
  1.  . . S NOTECNT=NOTECNT+1,ORY(NOTECNT)=NOTE
  1.  Q
  1. SAVEVIEW(Y,GMPLVIEW) ; -- save new view in File #200/Field #125
  1.  N TMP
  1.  Q:'$D(GMPLVIEW)
  1.  S TMP=$P($G(^VA(200,DUZ,125)),U,2,999)
  1.  S ^VA(200,DUZ,125)=$P(GMPLVIEW,U,1)_U_TMP
  1.  S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1)
  1.  I TMP'="" D  Q
  1.  . D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1,$P(GMPLVIEW,U,2))
  1.  D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1,$P(GMPLVIEW,U,2))
  1.  Q
  1.  ;