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

ORWRP2.m

Go to the documentation of this file.
  1. ORWRP2 ;SLC/DCM - Health Summary Adhoc RPC's ;08/30/2017 11:49
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,109,212,309,332,377**;Dec 17, 1997;Build 582
  1. BB ;Continuation of Blood Bank Report
  1. N DFN,ORY,ORSBHEAD,GCNT,GIOM
  1. S DFN=ORDFN,GCNT=0,GIOM=80
  1. K ^TMP("LRC",$J)
  1. S ROOT=$NA(^TMP("LRC",$J))
  1. D BLEG
  1. Q
  1. BLEG ;Legacy VISTA Blood Bank Report
  1. S ORSBHEAD("BLOOD BANK")=""
  1. D EN^LR7OSUM(.ORY,DFN,,,,GIOM,.ORSBHEAD),TRAN
  1. I '$O(^TMP("LRC",$J,0)) S GCNT=GCNT+1,^TMP("LRC",$J,GCNT,0)="",GCNT=GCNT+1,^TMP("LRC",$J,GCNT,0)="No Blood Bank report available..."
  1. Q
  1. COMP(ORY) ;Get ADHOC sub components (FILE 142.1)
  1. ;RPC => ORWRP2 HS COMPONENTS
  1. ;Y(i)=(1)I;IFN^(2)Component Name [Abb]^(3)Occ Limit^(4)Time Limit^(5)Header Name^
  1. ; (6)Hosp Loc Disp^(7)ICD Text Disp^(8)Prov Narr Disp^(9)Summary Order
  1. D COMP^GMTSADH5(.ORY)
  1. Q
  1. ;
  1. COMPABV(ORY) ;Get ADHOC sub components listed by Abbreviation
  1. N I,X,X1,X2,X3
  1. D COMP^GMTSADH5(.ORY)
  1. S I=0
  1. F S I=$O(ORY(I)) Q:'I S X=ORY(I) D
  1. . S X1=$P($P(X,"^",2),"["),X1=$E(X1,1,$L(X1)-1),X2=$P($P(X,"^",2),"[",2),X2=$E(X2,1,$L(X2)-1)
  1. . S:'$L(X2) X2="???" S:'$L($P(X,"^",5)) $P(X,"^",5)=$P($P(X,"^",2),"[") ;***
  1. . S X3=X2_" - "_$P(X,"^",5)_" ",$P(ORY(I),"^",2)=X3
  1. Q
  1. COMPDISP(ORY) ;Get ADHOC sub components listed by Display Name
  1. N I,X,X1,X2,X3
  1. D COMP^GMTSADH5(.ORY)
  1. S I=0
  1. F S I=$O(ORY(I)) Q:'I S X=ORY(I) D
  1. . S X1=$P($P(X,"^",2),"["),X1=$E(X1,1,$L(X1)-1),X2=$P($P(X,"^",2),"[",2),X2=$E(X2,1,$L(X2)-1)
  1. . S:'$L(X2) X2="???" S:'$L($P(X,"^",5)) $P(X,"^",5)=$P($P(X,"^",2),"[") ;***
  1. . S X3=$P(X,"^",5)_" ["_X2_"]",$P(ORY(I),"^",2)=X3
  1. Q
  1. COMPSUB(ORY,ORSUB) ;Get subitems from a predefined Adhoc component
  1. I '$L($T(COMPSUB^GMTSADH5)) Q
  1. D COMPSUB^GMTSADH5(.ORY,ORSUB)
  1. Q
  1. ;
  1. SAVLKUP(OK,VAL) ;save Adhoc lookup selection
  1. N ORERR
  1. S OK=""
  1. D EN^XPAR(DUZ_";VA(200,","ORWRP ADHOC LOOKUP",1,VAL,.ORERR)
  1. I ORERR S OK=VAL_":"_ORERR
  1. Q
  1. GETLKUP(ORY) ;Get Adhoc lookup selection
  1. S ORY=$$GET^XPAR("ALL","ORWRP ADHOC LOOKUP",1,"I")
  1. Q
  1. FILES(ORY,ORCOMP) ;Get Files to select from for a component
  1. ;RPC => ORWRP2 HS COMP FILES
  1. D FILES^GMTSADH5(.ORY,ORCOMP)
  1. Q
  1. ;
  1. FILESEL(OROOT,ORFILE,ORFROM,ORDIR) ;Get file entries for Combobox
  1. ;RPC => ORWRP2 HS FILE LOOKUP
  1. D FILESEL^GMTSADH5(.OROOT,ORFILE,ORFROM,ORDIR)
  1. Q
  1. ;
  1. REPORT(OROOT,ORCOMPS,ORDFN) ;Build Report from array of Components passed in COMPS
  1. ;RPC => ORWRP2 HS REPORT TEXT
  1. ;ORCOMPS(i)=array of subcomponents chosen, value is pointer at ^GMT(142,DA(1),1,DA)
  1. Q:'$G(ORDFN)
  1. N GMTSEGC,GMTSEG,ORGMTSEG,ORSEGC,ORSEGI
  1. K ^TMP("ORDATA",$J)
  1. D REPORT^GMTSADH5(.ORGMTSEG,.ORSEGC,.ORSEGI,.ORCOMPS,.ORDFN)
  1. Q:'$O(ORGMTSEG(0))
  1. D START^ORWRP(80,"REPORT1^ORWRP2(.ORGMTSEG,.ORSEGC,.ORSEGI,ORDFN)")
  1. S OROOT=$NA(^TMP("ORDATA",$J,1))
  1. Q
  1. REPORT1(GMTSEG,GMTSEGC,GMTSEGI,DFN) ;
  1. N GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM,GMTSLO,GMTSLPG,GMTSPHDR,GMTSPNM,GMTSRB,GMTSSN,GMTSWRD
  1. N CNT,INC,ORVP,ROOT,SEX,VADM,VAERR,VAIN
  1. S ORVP=DFN
  1. D ADHOC^ORPRS13
  1. Q
  1. ;
  1. SUBITEM(ORY,ORTEST) ;Get Subitems for a Test Panel
  1. ;RPC => ORWRP2 HS SUBITEMS
  1. D SUBITEM^GMTSADH5(.ORY,ORTEST)
  1. Q
  1. PREPORT(OROOT,ORCOMPS,ORDFN) ;Build Report & Print
  1. ;Called from File|Print on Reports Tab after selecting ADHOC Health Summary
  1. ;COMPS(i)=array of subcomponents chosen, value is pointer at ^GMT(142,DA(1),1,DA)
  1. Q:'$G(ORDFN)
  1. N GMTSEGC,GMTSEG,ORGMTSEG,ORSEGC,ORSEGI
  1. D REPORT^GMTSADH5(.ORGMTSEG,.ORSEGC,.ORSEGI,.ORCOMPS,.ORDFN)
  1. Q:'$O(ORGMTSEG(0))
  1. M GMTSEG=ORGMTSEG,GMTSEGC=ORSEGC,GMTSEGI=ORSEGI
  1. N GMTS,GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSDTM,GMTSLO,GMTSLPG,GMTSPHDR,GMTSPNM,GMTSRB,GMTSSN,GMTSWRD
  1. N CNT,INC,ORVP,ROOT,SEX,VADM,VAERR,VAIN
  1. S ORVP=ORDFN
  1. D ADHOC^ORPRS13
  1. Q
  1. TRAN ;Get Transfused Units
  1. N LRDFN,IDT,CNTR,TR,PN,PRODUCT,IX,GMI,X,BPN
  1. S:'$D(GMTS1) GMTS1=6666666 S:'$D(GMTS2) GMTS2=9999999
  1. K ^TMP("LRT",$J)
  1. Q:'$D(^DPT(DFN,"LR")) S LRDFN=+^DPT(DFN,"LR"),IDT=GMTS1-1
  1. I '$D(^LR(LRDFN)) Q
  1. S IDT=0 F S IDT=$O(^LR(LRDFN,1.6,IDT)) Q:+IDT'>0 D
  1. . S TR=$G(^LR(LRDFN,1.6,IDT,0)) D SET
  1. S IDT=0 F S IDT=$O(CNTR(IDT)) Q:+IDT'>0 D
  1. . S ^TMP("LRT",$J,IDT)=9999999-IDT_U,PN=0
  1. . F S PN=$O(CNTR(IDT,PN)) Q:PN'>0 D
  1. .. S PRODUCT=$G(^LAB(66,+PN,0)),^TMP("LRT",$J,$P(PRODUCT,U,2))=$P(PRODUCT,U)
  1. .. S ^TMP("LRT",$J,IDT)=^TMP("LRT",$J,IDT)_CNTR(IDT,PN)_"\"_$P(PRODUCT,U,2)_";"
  1. Q:'$O(^TMP("LRT",$J,0))
  1. S GCNT=+$O(^TMP("LRC",$J,999999999),-1)
  1. D LINE,LN
  1. S ^TMP("LRC",$J,GCNT,0)=$$S(0,CCNT,"Transfused Units"),IX=""
  1. F S IX=$O(^TMP("LRT",$J,IX)) Q:IX="" D
  1. . S GMR=^TMP("LRT",$J,IX),TD=$$FMTE^XLFDT(+GMR)
  1. . Q:TD=0
  1. . S GMA(1)=$P(GMR,U,2),BPN=$L(GMA(1),";")
  1. . I $P(GMA(1),";",BPN)="" S BPN=BPN-1
  1. . F GMI=2:1:BPN S GMA(GMI)="("_$P($P(GMA(1),";",GMI),"\")_") "_$P($P(GMA(1),";",GMI),"\",2)
  1. . S GMA(1)="("_$P($P(GMA(1),";",1),"\")_") "_$P($P(GMA(1),";",1),"\",2)
  1. . D WRT
  1. D KEY
  1. K ^TMP("LRT",$J)
  1. Q
  1. WRT ; Writes the Transfusion Record for each day
  1. N GML,GMI1,GMI2,GMM,GMJ,CL
  1. S GMM=$S(BPN#4:1,1:0),GML=BPN\4+GMM
  1. D LN S ^TMP("LRC",$J,GCNT,0)=$$S(2,.CCNT,TD)
  1. F GMI1=1:1:GML D
  1. . F GMI2=1:1:($S((GMI1=GML)&(BPN#4):BPN#4,1:4)) D
  1. .. S GMJ=((GMI1-1)*4)+GMI2,CL=(((GMI2-1)*15)+14)
  1. .. S ^TMP("LRC",$J,GCNT,0)=$G(^TMP("LRC",$J,GCNT,0))_$$S(CL,.CCNT,GMA(GMJ))
  1. .. I $S(GMI2#4=0:1,GMI2=BPN:1,GMI2+(4*(GMI1-1))=BPN:1,1:0) D LN
  1. Q
  1. SET ; Save Appropriate Data
  1. N COMP,UNITS,TDT,ITDT
  1. S TDT=9999999-IDT,ITDT=9999999-$P(TDT,".")
  1. S UNITS=+$P(TR,U,7) S:UNITS'>0 UNITS=1
  1. S CNTR(ITDT,+$P(TR,U,2))=+$G(CNTR(ITDT,+$P(TR,U,2)))+UNITS
  1. Q
  1. KEY ;
  1. I $O(^TMP("LRT",$J,"A"))'="" D
  1. . D LN
  1. . S ^TMP("LRC",$J,GCNT,0)=$$S(0,CCNT," Blood Product Key: ")
  1. S GMI="A" F S GMI=$O(^TMP("LRT",$J,GMI)) Q:GMI="" D
  1. . S ^TMP("LRC",$J,GCNT,0)=^TMP("LRC",$J,GCNT,0)_$$S(22,CCNT,GMI_" = "_$G(^TMP("LRT",$J,GMI)))
  1. . D LN
  1. . S ^TMP("LRC",$J,GCNT,0)=""
  1. Q
  1. LN ;
  1. S GCNT=GCNT+1,CCNT=1
  1. Q
  1. LINE ;Fill in the global with bank lines
  1. N X
  1. D LN
  1. S X="",$P(X," ",GIOM)="",^TMP("LRC",$J,GCNT,0)=X
  1. Q
  1. S(X,Y,Z) ;Pad over
  1. ;X=Column #
  1. ;Y=Current length
  1. ;Z=Text
  1. ;SP=TEXT SENT
  1. ;CCNT=Line position after input text
  1. I '$D(Z) Q ""
  1. S SP=Z I X,Y,X>Y S SP=$E(" ",1,X-Y)_Z
  1. S CCNT=$$INC(CCNT,SP)
  1. Q SP
  1. INC(X,Y) ;Character position count
  1. ;X=Current count
  1. ;Y=Text
  1. S INC=X+$L(Y)
  1. Q INC