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

ORAM1.m

Go to the documentation of this file.
ORAM1 ;POR/RSF - ANTICOAGULATION MANAGEMENT RPCS (2 of 4) ; 3/23/18 3:14pm
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**307,339,351,361,391,474,463**;Dec 17, 1997;Build 5
 ;;Per VHA Directive 2004-038, this routine should not be modified
 Q
 ;
 ;  External References:
 ;  $$EXTERNAL^DILFD     ICR #2055
 ;  $$FMTE/$$NOW^XLFDT   ICR #10103
 ;  $$GET^XPAR           ICR #2263
 ;
TERASE(RESULT,ORAMDFN,ORAMCOMP) ; Manage Team Lists
 N ORAMKEY,ORAMTMP,ORAMCEY,ORAMCLIN,ORAMCLNM,ORAMCOM,ORAMALL,ORAMCPLX,ORAMENT,QQ,DA,DIK,D0
 Q:'+$G(ORAMDFN)
 S ORAMCLIN=+$P($G(^ORAM(103,ORAMDFN,6)),U,2),ORAMENT=$S(+ORAMCLIN>0:ORAMCLIN_";SC(",1:"ALL")
 I +ORAMCLIN S ORAMCLNM=$$EXTERNAL^DILFD(103,101,"",ORAMCLIN)
 S ORAMALL=$$GET^XPAR(ORAMENT,"ORAM TEAM LIST (ALL)",1,"I"),ORAMCPLX=$$GET^XPAR(ORAMENT,"ORAM TEAM LIST (COMPLEX)",1,"I")
 I +$G(ORAMALL) D  I 1
 . S DA(1)=ORAMALL,DIK="^OR(100.21"_","_DA(1)_",10,"
 . S ORAMTMP=ORAMDFN_";DPT("
 . S ORAMKEY=$O(^OR(100.21,ORAMALL,10,"B",ORAMTMP,0)) Q:+ORAMKEY'>0  S DA=ORAMKEY
 . D ^DIK
 . K DA,DIK
 . K D0
 . S RESULT=1
 E  S RESULT="0^ORAM TEAM LIST (ALL) not defined for Clinic "_ORAMCLNM_"."
 I +$G(ORAMCPLX) D  I 1
 . S DA(1)=ORAMCPLX,DIK="^OR(100.21"_","_DA(1)_",10,"
 . S ORAMCEY=$O(^OR(100.21,ORAMCPLX,10,"B",ORAMTMP,0)) Q:+ORAMCEY'>0  S DA=ORAMCEY
 . D ^DIK
 . K DA,DIK
 . S:'$D(RESULT) RESULT=1
 E  S RESULT="0^ORAM TEAM LIST (COMPLEX) not defined for Clinic "_ORAMCLNM_"."
 Q
 ;
 ;ICDCODE(RESULT,ICODE); Map ICD Code //REMOVED BECAUSE OF DIRECT READ OF ^ICD9( FILE
 ;N ORAMICD
 ;S ORAMICD=ICODE_" "
 ;S RESULT=$O(^ICD9("AB",ORAMICD,0))
 ;Q
 ;
PTCHECK(RESULT,ORAMDFN) ; CHECKS TO SEE IF PT IS IN FILE
 N ORPTLOC
 Q:'+$G(ORAMDFN)
 S RESULT=0
 I $S('$D(^ORAM(103,ORAMDFN)):1,+$O(^ORAM(103,ORAMDFN,3,0))'>0:1,1:0) S RESULT=1 Q
 S ORPTLOC=$P($G(^ORAM(103,ORAMDFN,6)),U,2)
 I ORPTLOC']"" S RESULT=2 Q
 I +ORPTLOC,'$L($$GET^XPAR(ORPTLOC_";SC(^DIV.`"_DUZ(2),"ORAM CLINIC NAME",1,"I")) S RESULT=99
 Q
 ;
PTENTER(RESULT,DFN) ; ENTERS PATIENT INTO FILE WITH ALL DATES = TODAY
 N DO,DD,DIC,DINUM,X
 S DIC="^ORAM(103,"
 S DIC(0)="Z"
 S (DINUM,X)=DFN
 D FILE^DICN
 K DO,DD
 S RESULT=1
 Q
 ;
ACDATA(RESULT,DFN,ORAMEDT) ; HEADING DATA
 N ORAMSTOT,ORAMRTOT,ORAMRAT,ORAMMSGT,ORAMRAT,ORAMBRT,ORAMX,ORI,ORLINE
 N ORAMD0,ORAMD4,ORAMD5,ORAMD6,ORAMD9,ORAMD15,ORAMD17,ORAMD18
 N ORAMT4,ORAMT5,ORAMT6,ORAMT9,ORAMT15,ORAMT17,ORAMT18,ORAMDXT,ORAMDXC,ORDXI,ORAMPOP
 S ORAMEDT=$G(ORAMEDT,DT)
 S ORAMX=0
 I '$D(^ORAM(103,DFN)) D  ;IF NOT IN FILE ALREADY...
 . N DD,DIC,DINUM,DO,X
 . S DIC="^ORAM(103,"
 . S DIC(0)="Z"
 . S (DINUM,X)=DFN
 . D FILE^DICN
 . K DO,DD
 . S ORAMX=1
 I ORAMX=1 S RESULT(0)=0 G ACDATAQ
 S ORAMD0=^ORAM(103,DFN,0)
 S ORI=0 F  S ORI=$O(^ORAM(103,DFN,1,ORI)) Q:+ORI'>0  S ORLINE=$G(^ORAM(103,DFN,1,ORI,0)) S:ORLINE="" ORLINE=" " S ORAMSTOT=$G(ORAMSTOT)_U_ORLINE
 S ORI=0 F  S ORI=$O(^ORAM(103,DFN,2,ORI)) Q:+ORI'>0  S ORLINE=$G(^ORAM(103,DFN,2,ORI,0)) S:ORLINE="" ORLINE=" " S ORAMRTOT=$G(ORAMRTOT)_U_ORLINE
 S ORI=0 F  S ORI=$O(^ORAM(103,DFN,4,ORI)) Q:+ORI'>0  S ORLINE=$G(^ORAM(103,DFN,4,ORI,0)) S:ORLINE="" ORLINE=" " S ORAMMSGT=$G(ORAMMSGT)_U_ORLINE
 S ORI=0 F  S ORI=$O(^ORAM(103,DFN,5,ORI)) Q:+ORI'>0  S ORLINE=$G(^ORAM(103,DFN,5,ORI,0)) S:ORLINE="" ORLINE=" " S ORAMRAT=$G(ORAMRAT)_U_ORLINE
 S ORI=0 F  S ORI=$O(^ORAM(103,DFN,7,ORI)) Q:+ORI'>0  S ORLINE=$G(^ORAM(103,DFN,7,ORI,0)) S:ORLINE="" ORLINE=" " S ORAMBRT=$G(ORAMBRT)_U_ORLINE
 S RESULT(0)=$G(ORAMSTOT)
 S RESULT(1)=$G(ORAMRTOT)
 S RESULT(2)=$G(ORAMMSGT)
 S RESULT(4)=$G(ORAMRAT)
 S RESULT(5)=$S($G(ORAMBRT)]"":$P($G(^ORAM(103,DFN,6)),"^",5)_"^"_$P($G(ORAMBRT),"^",2,99),1:"")
 S ORAMD4=$P(ORAMD0,"^",4),ORAMD5=$P(ORAMD0,"^",5),ORAMD6=$P(ORAMD0,"^",6),ORAMD9=$P(ORAMD0,"^",9),ORAMD15=$P(ORAMD0,"^",15),ORAMD17=$P(ORAMD0,"^",17),ORAMD18=$P(ORAMD0,"^",18)
 S ORAMT4=$$FMTE^XLFDT($E($G(ORAMD4),1,12),"2P"),ORAMT5=$$FMTE^XLFDT($E($G(ORAMD5),1,12),"2P"),ORAMT6=$$FMTE^XLFDT($E($G(ORAMD6),1,12),"2P"),ORAMT9=$$FMTE^XLFDT($E($G(ORAMD9),1,12),"2P")
 S ORAMT15=$$FMTE^XLFDT($E($G(ORAMD15),1,12),"2P"),ORAMT17=$$FMTE^XLFDT($E($G(ORAMD17),1,12),"2P"),ORAMT18=$$FMTE^XLFDT($E($G(ORAMD18),1,12),"2P")
 S:$L($P(ORAMT4,"/",1))=1 $P(ORAMT4,"/",1)="0"_$P(ORAMT4,"/",1)
 S:$L($P(ORAMT4,"/",2))=1 $P(ORAMT4,"/",2)="0"_$P(ORAMT4,"/",2)
 S:$L($P(ORAMT15,"/",1))=1 $P(ORAMT15,"/",1)="0"_$P(ORAMT15,"/",1)
 S:$L($P(ORAMT15,"/",2))=1 $P(ORAMT15,"/",2)="0"_$P(ORAMT15,"/",2)
 S:$L($P(ORAMT17,"/",1))=1 $P(ORAMT17,"/",1)="0"_$P(ORAMT17,"/",1)
 S:$L($P(ORAMT17,"/",2))=1 $P(ORAMT17,"/",2)="0"_$P(ORAMT17,"/",2)
 S:$L($P(ORAMT18,"/",1))=1 $P(ORAMT18,"/",1)="0"_$P(ORAMT18,"/",1)
 S:$L($P(ORAMT18,"/",2))=1 $P(ORAMT18,"/",2)="0"_$P(ORAMT18,"/",2)
 ; OR*3*391 Check validity of legacy Dx code
 S ORAMDXT=$P($P(ORAMD0,U,3),"="),ORAMDXC=$P($P(ORAMD0,U,3),"=",2),ORAMPOP=0
 F ORDXI=1:1:$L(ORAMDXC,"/") D  Q:+ORAMPOP
 . N ORDXC,ORDX S ORDXC=$P(ORAMDXC,"/",ORDXI)
 . I (ORDXC]""),(ORDXC'[".") S ORDXC=ORDXC_"."
 . S ORDX=+$$ICDDATA^ICDXCODE("DIAGNOSIS",ORDXC,ORAMEDT,"E")
 . I +ORDX'>0 S ORAMDXC=""
 S $P(ORAMD0,U,3)=ORAMDXT_"="_ORAMDXC
 S $P(ORAMD0,"^",4)=$G(ORAMT4),$P(ORAMD0,"^",5)=$G(ORAMT5),$P(ORAMD0,"^",6)=$G(ORAMT6),$P(ORAMD0,"^",9)=$G(ORAMT9),$P(ORAMD0,"^",15)=$G(ORAMT15),$P(ORAMD0,"^",17)=$G(ORAMT17),$P(ORAMD0,"^",18)=$G(ORAMT18)
 S RESULT(3)=ORAMD0 S:$D(^ORAM(103,DFN,6)) RESULT(3)=RESULT(3)_"^"_$P(^ORAM(103,DFN,6),"^")
ACDATAQ Q
 ;
ADDTOP(RESULT,TOPARR) ; File ANTICOAG data
 N ORAM0,SI,RISK,PEEP,ORAMSIL,ORAMRL,ORAMPEPL,ORAMDAY,ORAMST,ORAMBACK,ORAMSTP,ORAMOR,ORAMFB,ORAMREM,ORAMRML,ORAMR,ORAMC
 N ORAMBRG,ORAMBRGC,ORAMBRGL,ORAMLOC,OLDRTN,DFN,R,X,FDA
 D NOW^%DTC S ORAMDAY=X
 S DFN=TOPARR(0),ORAM0=TOPARR(1),SI=TOPARR(2),RISK=TOPARR(3),PEEP=TOPARR(4),ORAMREM=TOPARR(5)
 S ORAMBRG=$G(TOPARR(6)),ORAMBRGC=$G(TOPARR(7)),ORAMLOC=$G(TOPARR(8))
 S OLDRTN=$P($G(^ORAM(103,DFN,0)),"^",4)
 I SI'="" K ^ORAM(103,DFN,1) S ORAMSIL=$L(SI,"^"),^ORAM(103,DFN,1,0)="^^"_ORAMSIL_"^"_ORAMSIL_"^"_ORAMDAY_"^" F R=1:1:ORAMSIL D
 . S ^ORAM(103,DFN,1,R,0)=$P(SI,"^",R)
 I RISK'="" K ^ORAM(103,DFN,2) S ORAMRL=$L(RISK,"^"),^ORAM(103,DFN,2,0)="^^"_ORAMRL_"^"_ORAMRL_"^"_ORAMDAY_"^" F R=1:1:ORAMRL D
 . S ^ORAM(103,DFN,2,R,0)=$P(RISK,"^",R)
 I PEEP'="" K ^ORAM(103,DFN,4) S ORAMPEPL=$L(PEEP,"^"),^ORAM(103,DFN,4,0)="^^"_ORAMPEPL_"^"_ORAMPEPL_"^"_ORAMDAY_"^" F R=1:1:ORAMPEPL D
 . S ^ORAM(103,DFN,4,R,0)=$P(PEEP,"^",R)
 K ^ORAM(103,DFN,5)
 I ORAMREM'="" D
 . S ORAMRML=$L(ORAMREM,"^"),^ORAM(103,DFN,5,0)="^^"_ORAMRML_"^"_ORAMRML_"^"_ORAMDAY_"^"
 . F R=1:1:ORAMRML S ^ORAM(103,DFN,5,R,0)=$P(ORAMREM,"^",R)
 ;*351 Use Fileman so x-ref updates.
 S:ORAMLOC>0 FDA(1,103,DFN_",",101)=ORAMLOC
 S FDA(1,103,DFN_",",111)=+ORAMBRG
 D UPDATE^DIE(,"FDA(1)")
 I +ORAMBRG,(ORAMBRGC]"") D
 . K ^ORAM(103,DFN,7)
 . S ORAMBRGL=$L(ORAMBRGC,"^"),^ORAM(103,DFN,7,0)="^^"_ORAMBRGL_"^"_ORAMBRGL_"^"_ORAMDAY_"^"
 . F R=1:1:ORAMBRGL S ^ORAM(103,DFN,7,R,0)=$P(ORAMBRGC,"^",R)
 I $P($G(ORAM0),"^",4)'="" S X="",ORAMBACK=$P(ORAM0,"^",4) D DT^DILF("TS",ORAMBACK,.X) S $P(ORAM0,"^",4)=X
 I $P($G(ORAM0),"^",15)'="" S X="",ORAMFB=$P(ORAM0,"^",15) D DT^DILF(,ORAMFB,.X) S $P(ORAM0,"^",15)=X
 I $P($G(ORAM0),"^",17)'="" S X="",ORAMC=$P(ORAM0,"^",17) D DT^DILF(,ORAMC,.X) S $P(ORAM0,"^",17)=X
 I $P($G(ORAM0),"^",18)'="" S X="",ORAMR=$P(ORAM0,"^",18) D DT^DILF(,ORAMR,.X) S $P(ORAM0,"^",18)=X
 I OLDRTN'="" K ^ORAM(103,"L",OLDRTN,DFN)
 S ^ORAM(103,DFN,0)=ORAM0 S:$P($G(ORAM0),"^",4)'="" ^ORAM(103,"L",$P(ORAM0,"^",4),DFN)=""
 I $P(^ORAM(103,DFN,0),"^",13)="" S $P(^ORAM(103,DFN,0),"^",13)="SAVE"
 Q
 ;
OUTINR(RESULT,ORAMINR) ; INR VALUES FROM OUTSIDE LAB
 N ORAMLEN,ORAMPI,ORAMRI,ORAMZANY,ORAMHDT,ORAMNDT
 S ORAMLEN=$L($G(ORAMINR),"^"),ORAMRI=0
 F ORAMPI=1:2:ORAMLEN D
 . N %H,ORAMDT,X
 . S ORAMDT=$P(ORAMINR,"^",ORAMPI+1) I $L(ORAMDT) D DT^DILF("E",ORAMDT,.ORAMZANY) S X=ORAMZANY D H^%DTC S ORAMHDT=%H,ORAMNDT=$$FMTE^XLFDT(X,"2P")
 . I $L(ORAMDT) S RESULT(ORAMRI)=$P(ORAMINR,"^",ORAMPI)_"^"_$G(ORAMHDT)_"^"_$G(ORAMNDT)
 . E  S RESULT(ORAMRI)="^^"
 . S ORAMRI=ORAMRI+1
 Q
 ;
PCGOAL(RESULT,DFN,CMPLX) ; % of time Pt in current goal
 N ORAMSNO,ORAMPC,R,ORAMGOOD,ORAMDATE
 S R=0,ORAMGOOD=0,ORAMDATE=0
 S ORAMSNO=0 F  S ORAMSNO=$O(^ORAM(103,DFN,3,ORAMSNO)) Q:'ORAMSNO  D
 . N ORAMD0,ORAMINR,ORAMGOAL,ORAMGLOW,ORAMHIGH,LCNT,ORAMND
 . S ORAMD0=$G(^ORAM(103,DFN,3,ORAMSNO,0)),LCNT=$P($G(^ORAM(103,DFN,3,ORAMSNO,1,0)),"^",3)-1
 . I $G(CMPLX)=1,$G(^ORAM(103,DFN,3,ORAMSNO,1,LCNT,0))["COMPLEX PATIENT" Q
 . S ORAMND=$P(ORAMD0,"^"),ORAMINR=$P(ORAMD0,"^",3),ORAMGOAL=$P(ORAMD0,"^",12),ORAMGLOW=$P(ORAMGOAL,"-"),ORAMHIGH=$P(ORAMGOAL,"-",2) S:ORAMHIGH[" " ORAMHIGH=$P(ORAMHIGH," ",2)
 . S ORAMGLOW=ORAMGLOW-(.1*ORAMGLOW),ORAMHIGH=ORAMHIGH+(.1*ORAMHIGH)
 . I (ORAMND'=ORAMDATE)&(ORAMINR) S R=R+1,ORAMDATE=ORAMND I ((ORAMINR'<ORAMGLOW)&(ORAMINR'>ORAMHIGH)) S ORAMGOOD=ORAMGOOD+1
 I R>0 S ORAMPC=(ORAMGOOD/R)*100,ORAMPC=$E(ORAMPC,1,4)
 S RESULT=$G(ORAMPC)_"^"_$G(R)
PCGOALQ Q
 ;
COMPTEST(RESULT,COMMARR) ; File Flow Sheet Data
 ; RPC: ORAM1 COMPTEST
 N ORAMDFN,ORAMZERO,ORAMCOMM,ORAMDT,ORAMX,ORAMCL,ORAMTEMP,ORAMSAVE,ORAMRD,ORAMCOMPL,ORAMCCNT,DA,DIK,R,X
 N ORAMICNT,ORAMIOFF
 S ORAMDFN=COMMARR(0),ORAMZERO=COMMARR(1),ORAMSAVE=COMMARR(2),ORAMRD=COMMARR(3),ORAMCOMPL=COMMARR(4),ORAMCCNT=COMMARR(5)
 S ORAMIOFF=+ORAMCCNT+6,ORAMICNT=COMMARR(ORAMIOFF)
 S ORAMTEMP=$P(ORAMZERO,"^",1) D DT^DILF(,ORAMTEMP,.X) S $P(ORAMZERO,"^",1)=$S($G(X)]"":$G(X),1:DT)
 S ORAMDT=$$NOW^XLFDT
 S:$P(ORAMZERO,"^",9)="" $P(ORAMZERO,"^",9)=ORAMDT
 S ORAMX=$O(^ORAM(103,ORAMDFN,3," "),-1)
 I 'ORAMX S ORAMX=0
 I $P(^ORAM(103,ORAMDFN,0),"^",13)="TEMPSAVE" K DIK,DA S DIK="^ORAM(103,"_ORAMDFN_",3,",DA(1)=ORAMDFN,DA=ORAMX D ^DIK
 I $P(^ORAM(103,ORAMDFN,0),"^",13)="SAVE" S ORAMX=ORAMX+1
 ; Execute KILL Logic for cross-refs on update
 I $D(^ORAM(103,ORAMDFN)) D
 . S DIK="^ORAM(103,"
 . S DA=ORAMDFN
 . D IX2^DIK
 S ^ORAM(103,ORAMDFN,3,0)="^103.011DA^"_ORAMX_"^"_ORAMX
 S ^ORAM(103,ORAMDFN,3,ORAMX,0)=ORAMZERO
 I $P(ORAMRD,U,4)]"" S $P(^ORAM(103,ORAMDFN,6),U,1,4)=ORAMRD
 E  S $P(^ORAM(103,ORAMDFN,6),U,1,3)=$P(ORAMRD,U,1,3)
 ; If there are comments, file them
 I +ORAMCCNT>0 F R=1:1:(ORAMCCNT) D
 . S ^ORAM(103,ORAMDFN,3,ORAMX,1,R,0)=COMMARR(R+5)
 . S ^ORAM(103,ORAMDFN,3,ORAMX,1,0)="^^"_ORAMCCNT_"^"_ORAMCCNT_"^"_$P(ORAMZERO,"^",1)_"^"
 ; If there are complications, file them
 I $L(ORAMCOMPL)>0 D
 . N P1,P2,X
 . S P1=$P(ORAMCOMPL,"|"),P2=$P(ORAMCOMPL,"|",2)
 . I P1>99 S P1=2 ;CLOT in the 100 range...
 . E  I P1#10>0 S P1=1 ;MAJOR BLEED
 . E  I P1=10 S P1=3 ;MINOR BLEED
 . S:+$G(P1) $P(^ORAM(103,ORAMDFN,3,ORAMX,0),"^",2)=P1
 . F X=1:1:$L(P2,"^") D
 .. S ^ORAM(103,ORAMDFN,3,ORAMX,2,X,0)=$P(P2,"^",X)
 . S ^ORAM(103,ORAMDFN,3,ORAMX,2,0)="^^"_$L(P2,"^")-1_"^"_$L(P2,"^")-1_"^"_$P(ORAMZERO,"^",1)_"^"
 ; If there are Patient Instructions, file them
 I +ORAMICNT>0 F R=1:1:(ORAMICNT) D
 . N ORLINE S ORLINE=COMMARR(R+ORAMIOFF)
 . S ^ORAM(103,ORAMDFN,3,ORAMX,3,R,0)=$S(ORLINE="":" ",1:ORLINE)
 . S ^ORAM(103,ORAMDFN,3,ORAMX,3,0)="^^"_ORAMICNT_"^"_ORAMICNT_"^"_$P(ORAMZERO,"^",1)_"^"
 S ^ORAM(103,ORAMDFN,3,"B",$P(ORAMZERO,"^",1),ORAMX)=""
 S $P(^ORAM(103,ORAMDFN,0),"^",13)=ORAMSAVE
 ; Update all cross-refs for Flow Sheet entry
 S DIK="^ORAM(103,"
 S DA=ORAMDFN
 D IX^DIK
 S RESULT=1
 Q
 ;
FLOWTT(RESULT,DFN) ; GETS ANTICOAG FLOWSHEET DATA
 N FSARR,COMARR,ORAMI,ORI,ORX
 S (ORI,ORAMI,ORX)=0
 F  S ORI=$O(^ORAM(103,DFN,3,"B",ORI)) Q:+ORI'>0  D
 . N ORJ S ORJ=0
 . F  S ORJ=$O(^ORAM(103,DFN,3,"B",ORI,ORJ)) Q:+ORJ'>0  D
 .. N ORAMACFS,ORAMCOM,ORAMCOMP,ORAMCC,ORAMPROV,ORAMLCNT,ORAMTOT,ORAMT,OUTSIDEHCT
 .. S ORAMACFS=^ORAM(103,DFN,3,ORJ,0),ORAMCC=$P(ORAMACFS,U,2)
 .. S OUTSIDEHCT=$P(^ORAM(103,DFN,6),U,4)
 .. S ORAMCOM=$P(ORAMACFS,U),$P(ORAMACFS,U)=$$FMTE^XLFDT(ORAMCOM,"2P"),$P(ORAMACFS,U,2)=ORJ
 .. S ORAMPROV=$P(ORAMACFS,U,10) I +$G(ORAMPROV) S $P(ORAMACFS,U,10)=$P(^VA(200,+ORAMPROV,0),U)
 .. S ORAMLCNT=+$O(^ORAM(103,DFN,3,ORJ,1,""),-1)
 .. S ORAMCOMP=$O(^ORAM(103,DFN,3,ORJ,2,""),-1)
 .. S ORAMT=ORAMLCNT
 .. S:+$G(ORAMCC) ORAMT=$G(ORAMLCNT)_","_$G(ORAMCOMP)
 .. S ORAMTOT=$G(ORAMLCNT)+$G(ORAMCOMP)
 .. I +$G(ORAMTOT) D
 ... S RESULT(ORAMI)=$G(ORAMT)_"|"_$G(ORAMACFS)_U_OUTSIDEHCT
 ... I +$G(ORAMLCNT) F ORX=(ORAMI+1):1:(ORAMLCNT+ORAMI) S RESULT(ORX)=$G(^ORAM(103,DFN,3,ORJ,1,(ORX-ORAMI),0))
 ... I +$G(ORAMCC),+$G(ORAMCOMP) D
 .... S ORAMI=ORX+2,RESULT(ORAMI)="Complications noted:"
 .... F ORX=(ORAMI+2):1:(ORAMCOMP+ORAMI) D
 ..... N ORAMCMPL
 ..... S ORAMCMPL=$G(^ORAM(103,DFN,3,ORJ,2,(ORX-ORAMI),0))
 ..... S RESULT(ORX)=$S((ORAMCMPL["MB:")!(ORAMCMPL["C:"):$P(ORAMCMPL,":",2),1:ORAMCMPL)
 .. E  S RESULT(ORAMI+1)="0|"_$G(ORAMACFS)
 .. S ORAMI=ORX+1
 Q
 ;
LOGIT(RESULT,FSARRAY,ORAMCOMP) ; RPC= ORAM1 LOG
 N ORAMDATE,ORAMINR,ORAMPTN,ORAMTWD,ORAMLOG,ORAMLOGN,TODAY,TTIME,COUNT,ORAMODFN,ORAMOD,ORAMND,ORAMNEWD,AROW
 N %,DA,DIK,ORAMDFN,ORAMRSF,R,X
 S RESULT=0
 D NOW^%DTC S TODAY=X,TTIME=%
 ;FIRST GET THE OLD FLOW SHEET DATA AND SAVE TO THE LOG FILE
 S ORAMDFN=$G(FSARRAY(0)),AROW=$G(FSARRAY(1))
 S ORAMDATE=$P($G(^ORAM(103,ORAMDFN,3,AROW,0)),"^"),ORAMINR=$P($G(^ORAM(103,ORAMDFN,3,AROW,0)),"^",3),ORAMPTN=$P($G(^ORAM(103,ORAMDFN,3,AROW,0)),"^",8),ORAMTWD=$P($G(^ORAM(103,ORAMDFN,3,AROW,0)),"^",6)
 S ORAMODFN=$P($G(^ORAM(103,ORAMDFN,3,AROW,0)),"^",10),ORAMOD=$P($G(^ORAM(103,ORAMDFN,3,AROW,0)),"^",9)
 S ORAMLOG="Original FS "_AROW_": DATE="_$G(ORAMDATE)_", INR="_$G(ORAMINR)_", PT NOTIFIED="_$G(ORAMPTN)_", TWD="_$G(ORAMTWD)_"; "_ORAMODFN_" ("_ORAMOD_"): EDITED: "_FSARRAY(6)_"("_TODAY_")"
 S ORAMLOGN=$P($G(^ORAM(103,ORAMDFN,3,AROW,"LOG",0)),"^",3)+1
 S ^ORAM(103,ORAMDFN,3,AROW,"LOG",ORAMLOGN,0)=ORAMLOG
 K ^ORAM(103,ORAMDFN,3,"B",$G(ORAMDATE),AROW)
 F ORAMRSF=1:1:$P($G(^ORAM(103,ORAMDFN,3,AROW,1,0)),"^",3) S COUNT=ORAMLOGN+ORAMRSF,^ORAM(103,ORAMDFN,3,AROW,"LOG",COUNT,0)=^ORAM(103,ORAMDFN,3,AROW,1,ORAMRSF,0)
 S ^ORAM(103,ORAMDFN,3,AROW,"LOG",0)="^^"_$G(COUNT)_"^"_$G(COUNT)_"^"_TODAY
 ;NOW SET NEW INFO FOR THE FLOW SHEET ENTRY
 ;Array order is: DFN;ARow;date;inr;ptnotified;twd;DUZ;#comment lines;comments
 S ORAMNEWD=$G(FSARRAY(2)) D DT^DILF(,ORAMNEWD,.X) S ORAMNEWD=X
 S $P(^ORAM(103,ORAMDFN,3,AROW,0),"^")=$G(ORAMNEWD),$P(^ORAM(103,ORAMDFN,3,AROW,0),"^",3)=$G(FSARRAY(3)),$P(^ORAM(103,ORAMDFN,3,AROW,0),"^",8)=$G(FSARRAY(4)),$P(^ORAM(103,ORAMDFN,3,AROW,0),"^",6)=$G(FSARRAY(5))
 I $G(ORAMCOMP)=0 S $P(^ORAM(103,ORAMDFN,3,AROW,0),"^",2)=0
 S $P(^ORAM(103,ORAMDFN,3,AROW,0),"^",10)=$G(FSARRAY(6)),$P(^ORAM(103,ORAMDFN,3,AROW,0),"^",9)=TTIME
 I $G(FSARRAY(7))'="" K ^ORAM(103,ORAMDFN,3,AROW,1) F R=1:1:$G(FSARRAY(7)) D
 . S ^ORAM(103,ORAMDFN,3,AROW,1,R,0)=$G(FSARRAY(R+7))
 S ^ORAM(103,ORAMDFN,3,AROW,1,0)="^^"_$G(FSARRAY(7))_"^"_$G(FSARRAY(7))_"^"_TODAY_"^"  ;$E(ORAMDT,1,7)_"^"
 S ^ORAM(103,ORAMDFN,3,"B",$G(ORAMNEWD),AROW)=""
 S DIK="^ORAM(103,"
 S DA(1)=ORAMDFN,DA=AROW
 D IX^DIK
 S RESULT=1
 Q
 ;
LOCK(RESULT,DATA) ; Locks form   RPC=ORAM1 LOCK
 N X
 S RESULT=0
 Q:$P($G(DATA),"^")=""
 Q:$D(^ORAM(103,$P(DATA,"^")))=0
 D NOW^%DTC N ORAMTDAY S ORAMTDAY=X
 I $P(^ORAM(103,$P(DATA,"^"),0),"^",18,19)="" S $P(^ORAM(103,$P(DATA,"^"),0),"^",18)="^"
 S $P(^ORAM(103,$P(DATA,"^"),0),"^",19)=1_"|"_$P(^VA(200,$P(DATA,"^",2),0),"^")_"|"_ORAMTDAY,RESULT=1
 Q
 ;
UNLOCK(RESULT,DFN) ; Unlocks form  RPC=ORAM1 UNLOCK
 S RESULT=0
 Q:DFN<1
 Q:$D(^ORAM(103,DFN))=0
 S $P(^ORAM(103,DFN,0),"^",19)=0,RESULT=1
 Q
 ;
GETPT(RESULT) ; Get Pt list  RPC=ORAM1 PT LIST
 N ORAMPT
 S ORAMPT=0 F  S ORAMPT=$O(^ORAM(103,"B",ORAMPT)) Q:ORAMPT=""  D
 . S RESULT($G(ORAMPT))=$G(ORAMPT)_"^"_$P(^DPT(ORAMPT,0),"^")_"^"_$E($P(^DPT(ORAMPT,0),"^",9),6,9)
 Q
 ;
SETHCT(RESULT,ORAMORD) ; SET HCT LAB ITEM NUMBER
 Q:'+$G(ORAMORD)
 N ORAMX,ORAML60,ORAMCH S ORAMX=0 F  S ORAMX=$O(^ORD(101.43,$G(ORAMORD),10,ORAMX)) Q:'+$G(ORAMX)!+$G(ORAMCH)  D
 . I $P(^ORD(101.43,$G(ORAMORD),10,ORAMX,0),"^")["HCT" S ORAML60=+$P(^(0),"^",2)
 . I +$G(ORAML60) S ORAMCH=$P($P(^LAB(60,ORAML60,0),"^",5),";",2) S RESULT=ORAMCH
 Q
 ;