ORAM3.m

ORAM3 ;POR/RSF - ANTICOAGULATION MANAGEMENT RPCS (4 of 4)  ;12/09/09  14:44

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**307**;Dec 17, 1997;Build 60

 ;;Per VHA Directive 2004-038, this routine should not be modified

 Q

 ;

PTADR(RESULT,ORAMDFN) ;GET PT ADDRESS

 ;;CALLED BY ORAM3 ADDRESS

 N ORAMADD,ORAMADD2,ORAMADD3,ORAMCITY,ORAMCODE,ORAMST,ORAMZIP,ORAMBAD,ORAMT

 S ORAMT=.11,ORAMST="",ORAMBAD=0

 I '$G(ORAMDFN) S RESULT="NONE" Q

 I $$TMPCHK(ORAMDFN)=1 S ORAMT=.121

 S ORAMADD=$P($G(^DPT(ORAMDFN,ORAMT)),"^"),ORAMADD2=$P($G(^DPT(ORAMDFN,ORAMT)),"^",2),ORAMADD3=$P($G(^DPT(ORAMDFN,ORAMT)),"^",3)

 S ORAMCITY=$P($G(^DPT(ORAMDFN,ORAMT)),"^",4),ORAMCODE=$P($G(^DPT(ORAMDFN,ORAMT)),"^",5),ORAMZIP=$P($G(^DPT(ORAMDFN,ORAMT)),"^",6),ORAMBAD=$P($G(^DPT(ORAMDFN,.11)),"^",16)

 I ORAMCODE S ORAMST=$P($G(^DIC(5,$G(ORAMCODE),0)),"^",2)

 S:$G(ORAMBAD)="" ORAMBAD=0

 S RESULT=ORAMADD_"^"_ORAMADD2_"^"_ORAMADD3_"^"_ORAMCITY_"^"_ORAMST_"^"_ORAMZIP_"^"_$G(ORAMBAD)_"^"_$G(ORAMT)

 Q

 ;

PTFONE(RESULT,ORAMDFN) ;GET PT PHONE NUMBERS

 ;;RPC=ORAM3 PHONE

 ;;RESULT=HOMEPHONE^WORKPHONE^CELLNUMBER^PAGER^EMAIL

 N ORAMF1,ORAMF2,ORAMFC,ORAMP,ORAMEM,ORAMT S ORAMT=0

 I '$G(ORAMDFN) S RESULT="NONE" Q

 I $$TMPCHK(ORAMDFN)=1 S ORAMT=1

 I ORAMT=0 D

 . S ORAMF1=$P($G(^DPT(ORAMDFN,.13)),"^"),ORAMF2=$P($G(^DPT(ORAMDFN,.13)),"^",2)

 . S ORAMFC=$P($G(^DPT(ORAMDFN,.13)),"^",4),ORAMP=$P($G(^DPT(ORAMDFN,.13)),"^",5),ORAMEM=$P($G(^DPT(ORAMDFN,.13)),"^",3)

 I ORAMT=1 D

 . S ORAMF1=$P($G(^DPT(ORAMDFN,.121)),"^",10),ORAMF2=$P($G(^DPT(ORAMDFN,.13)),"^",2)

 . S ORAMFC=$P($G(^DPT(ORAMDFN,.13)),"^",4),ORAMP=$P($G(^DPT(ORAMDFN,.13)),"^",5),ORAMEM=$P($G(^DPT(ORAMDFN,.13)),"^",3)

 S RESULT=$G(ORAMF1)_"^"_$G(ORAMF2)_"^"_$G(ORAMFC)_"^"_$G(ORAMP)_"^"_$G(ORAMEM)_"^"_$G(ORAMT)

 Q

 ;

TMPCHK(ORAMDFN) ;

 ;;

 N ORAMTMP S ORAMTMP=0

 I $D(^DPT(ORAMDFN,.121)),$P(^DPT(ORAMDFN,.121),"^",9)="Y" D

 . Q:$P(^DPT(ORAMDFN,.121),"^",7)>DT  ;START DATE

 . I $P(^DPT(ORAMDFN,.121),"^",8)'="" Q:DT>$P(^DPT(ORAMDFN,.121),"^",8)  ;END DATE

 . S ORAMTMP=1

 Q ORAMTMP

 ;RSF 10/08/08  CHANGE TO CODE DUE TO NEWLY DISCOVERED PROBLEM WITH 'COMPLICATIONS'

COMPENT(RESULT,ORAMDFN,ORAMDUZ,ORAMC,ORAMCT,ORAMD2) ;

 ;RPC=ORAM3 COMPLICATION

 Q:'+$G(ORAMDFN)

 Q:'$G(ORAMDUZ)

 Q:'+$G(ORAMC)

 Q:$G(ORAMD2)=""

 N ORAMD3,ORAMX D DT^DILF(,ORAMD2,.ORAMX) S ORAMD3=ORAMX

 N ORAMNOW,ORAMDAY,X,% D NOW^%DTC S ORAMNOW=%,ORAMDAY=X

 N ORAMNX S ORAMNX=$O(^ORAM(103,ORAMDFN,3," "),-1)+1

 N ORAMC2,ORAMLLOC,ORAMPS,ORAMDD,ORAMTWD,ORAML,OERR

 I '$G(ORAMNX) S ORAMNX=1

 I ORAMNX>1 D

 . S ORAML=ORAMNX-1,ORAMLLOC=$P(^ORAM(103,ORAMDFN,3,ORAML,0),"^",4),ORAMPS=$P(^(0),"^",5),ORAMTWD=$P(^(0),"^",6),ORAMDD=$P(^(0),"^",7)

 I ORAMC>99 S ORAMC2=2  ;CLOT in the 100 range...I P1>100,P1#100>0 S P1=3 Q

 I ORAMC#10>0 S ORAMC2=1  ;MAJOR BLEED I P1>99 S P1=2 Q

 I ORAMC=10 S ORAMC2=3  ;MINOR BLEED

 N DA,IENS,ORAMRSF,ORAMF

 S IENS="+1,"_ORAMDFN_","

 S DA=ORAMNX,DA(1)=ORAMDFN

 S ORAMRSF(103.011,IENS,.01)=ORAMD3  ;COMPLICATION DATE

 S ORAMRSF(103.011,IENS,30)=ORAMLLOC  ;LAB DRAW LOC

 S ORAMRSF(103.011,IENS,40)=ORAMPS  ;PILL STRENGTH

 S ORAMRSF(103.011,IENS,50)=ORAMTWD  ;TOTAL WEEK DOSE

 S ORAMRSF(103.011,IENS,60)=ORAMDD  ;DAILY DOSING

 S ORAMRSF(103.011,IENS,80)=ORAMNOW

 S ORAMRSF(103.011,IENS,90)=ORAMDUZ  ;PROVIDER

 S ORAMRSF(103.011,IENS,104)=ORAMC2  ;COMPLICATION CODE

 K ORAMF

 S ORAMF(ORAMNX)=DA

 K OERR

 D UPDATE^DIE("","ORAMRSF","ORAMF","OERR")

 S ^ORAM(103,ORAMDFN,3,ORAMNX,2,1,0)=ORAMD2

 I $L(ORAMCT,"^")>0 N ORAMCC F ORAMCC=1:1:$L(ORAMCT,"^") D  S ^ORAM(103,ORAMDFN,3,ORAMNX,2,0)="^^"_ORAMCC_"^"_ORAMCC_"^"_ORAMDAY_"^"

 . S ^ORAM(103,ORAMDFN,3,ORAMNX,2,ORAMCC+1,0)=$P(ORAMCT,"^",ORAMCC)

 S RESULT=1

 Q

 ;

TLISTS ; Erases and sets Team Lists for Anticoagulation Clinics

 ; Option: ORAM SET TEAMS

 N ORAMLIST  ;ARRAYS OF TEAMS

 D FTL(.ORAMLIST)

 I '$D(ORAMLIST) Q  ;No lists defined

 D ETEAM(.ORAMLIST)  ;ERASE ALL TEAM LISTS

 D MTEAM(.ORAMLIST)  ;FORM TODAY'S TEAM LISTS

 Q

 ;

FTL(ORAMLIST) ;FIND TEAM LISTS  CALLED FROM TLISTS

 ;

 N ORAMI,ORAMCLST S ORAMI=0

 D GETCLINS^ORAMSET(.ORAMCLST)

 I +$G(ORAMCLST(0))'>0 Q  ;Site not SET UP

 ; Loop through Clinics, get team lists for each

 F  S ORAMI=$O(ORAMCLST(ORAMI)) Q:+ORAMI'>0  D

 . N ORAMCL,ORAMALL,ORAMCPLX

 . S ORAMCL=$P($G(ORAMCLST(ORAMI)),U,2) Q:+ORAMCL'>0

 . S ORAMALL=$$GET^XPAR(ORAMCL,"ORAM TEAM LIST (ALL)",1,"I")

 . S:ORAMALL]"" ORAMLIST(ORAMCL,"ALL")=ORAMALL

 . S ORAMCPLX=$$GET^XPAR(ORAMCL,"ORAM TEAM LIST (COMPLEX)",1,"I")

 . S:ORAMCPLX]"" ORAMLIST(ORAMCL,"COMPLEX")=ORAMCPLX

 Q

 ;

ETEAM(ORAMLIST) ; Remove all Anticoagulation Patients from their respective lists

 ; called from TLISTS

 N ORAMI S ORAMI=""

 F  S ORAMI=$O(ORAMLIST(ORAMI)) Q:ORAMI']""  D

 . N ORAML S ORAML=""

 . F  S ORAML=$O(ORAMLIST(ORAMI,ORAML)) Q:ORAML']""  D

 . . N DO,DA,DIK

 . . S DA(1)=ORAMLIST(ORAMI,ORAML),DIK="^OR(100.21"_","_DA(1)_",10,"

 . . S DA=0 F  S DA=$O(^OR(100.21,DA(1),10,DA)) Q:+DA'>0  D

 . . . D ^DIK

 Q

 ;

MTEAM(ORAMLIST) ; Build Today's Team Lists

 ; CALLED FROM TLISTS

 N ORAMCL S ORAMCL=""

 ; Loop through ORAMLIST by clinic location

 F  S ORAMCL=$O(ORAMLIST(ORAMCL)) Q:ORAMCL']""  D

 . N ORAMCN,ORAMCA,ORAMCC,ORAMDFN

 . S ORAMCN=+ORAMCL                        ; Pointer to file 44

 . S ORAMCA=$G(ORAMLIST(ORAMCL,"ALL"))     ; Pointer to "All" List

 . S ORAMCC=$G(ORAMLIST(ORAMCL,"COMPLEX")) ; Pointer to "Complex" List

 . ; Loop through Anticoagulation Patients by location

 . S ORAMDFN=0

 . F  S ORAMDFN=$O(^ORAM(103,"CL",ORAMCN,ORAMDFN)) Q:+ORAMDFN'>0  D

 . . N ORAMD0,ORAMRDT,ORAMCPLX,ORAMNDCB,ORAMAXDT

 . . S ORAMD0=$G(^ORAM(103,ORAMDFN,0))

 . . S ORAMRDT=$P(ORAMD0,U,4)   ; Pt's Return Date

 . . S ORAMAXDT=DT_".2359"      ; Upper bound for return date range

 . . S ORAMCPLX=$P(ORAMD0,U,10) ; Pt's Complexity

 . . S ORAMNDCB=$P(ORAMD0,U,20) ; Next Day Callback

 . . ; if next day callback, increment return date, disregard time

 . . I +ORAMNDCB S ORAMRDT=$$FMADD^XLFDT($P(ORAMRDT,"."),1)

 . . ; if future return date or pt inactive, quit to next pt

 . . I (ORAMRDT>ORAMAXDT)!(ORAMCPLX=2) Q

 . . ; otherwise, add pt to appropriate list(s) for location

 . . D ADDLIST(ORAMDFN,ORAMCA) ; All active pts on "ALL" List

 . . I ORAMCPLX=1 D ADDLIST(ORAMDFN,ORAMCC) ; Complex pts also on "COMPLEX" List

 Q

ADDLIST(ORAMDFN,ORAMLDA) ; Add pt to Team List / Assure record is UNLOCKED

 N DIC,DA,DO,X,ORAMLR

 S X=ORAMDFN_";DPT("

 S DA(1)=ORAMLDA,DIC="^OR(100.21"_","_DA(1)_",10,",DIC(0)="L" D FILE^DICN

 D UNLOCK^ORAM1(.ORAMLR,ORAMDFN)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ORAM3   6539     printed  Mar 13, 2025@21:31:58                                                                                                                                                                                                       Page 2

ORAM3     ;POR/RSF - ANTICOAGULATION MANAGEMENT RPCS (4 of 4)  ;12/09/09  14:44

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**307**;Dec 17, 1997;Build 60

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified

 +3        QUIT 

 +4       ;

PTADR(RESULT,ORAMDFN) ;GET PT ADDRESS

 +1       ;;CALLED BY ORAM3 ADDRESS

 +2        NEW ORAMADD,ORAMADD2,ORAMADD3,ORAMCITY,ORAMCODE,ORAMST,ORAMZIP,ORAMBAD,ORAMT

 +3        SET ORAMT=.11

           SET ORAMST=""

           SET ORAMBAD=0

 +4        IF '$GET(ORAMDFN)

               SET RESULT="NONE"

               QUIT 

 +5        IF $$TMPCHK(ORAMDFN)=1

               SET ORAMT=.121

 +6        SET ORAMADD=$PIECE($GET(^DPT(ORAMDFN,ORAMT)),"^")

           SET ORAMADD2=$PIECE($GET(^DPT(ORAMDFN,ORAMT)),"^",2)

           SET ORAMADD3=$PIECE($GET(^DPT(ORAMDFN,ORAMT)),"^",3)

 +7        SET ORAMCITY=$PIECE($GET(^DPT(ORAMDFN,ORAMT)),"^",4)

           SET ORAMCODE=$PIECE($GET(^DPT(ORAMDFN,ORAMT)),"^",5)

           SET ORAMZIP=$PIECE($GET(^DPT(ORAMDFN,ORAMT)),"^",6)

           SET ORAMBAD=$PIECE($GET(^DPT(ORAMDFN,.11)),"^",16)

 +8        IF ORAMCODE

               SET ORAMST=$PIECE($GET(^DIC(5,$GET(ORAMCODE),0)),"^",2)

 +9        if $GET(ORAMBAD)=""

               SET ORAMBAD=0

 +10       SET RESULT=ORAMADD_"^"_ORAMADD2_"^"_ORAMADD3_"^"_ORAMCITY_"^"_ORAMST_"^"_ORAMZIP_"^"_$GET(ORAMBAD)_"^"_$GET(ORAMT)

 +11       QUIT 

 +12      ;

PTFONE(RESULT,ORAMDFN) ;GET PT PHONE NUMBERS

 +1       ;;RPC=ORAM3 PHONE

 +2       ;;RESULT=HOMEPHONE^WORKPHONE^CELLNUMBER^PAGER^EMAIL

 +3        NEW ORAMF1,ORAMF2,ORAMFC,ORAMP,ORAMEM,ORAMT

           SET ORAMT=0

 +4        IF '$GET(ORAMDFN)

               SET RESULT="NONE"

               QUIT 

 +5        IF $$TMPCHK(ORAMDFN)=1

               SET ORAMT=1

 +6        IF ORAMT=0

               Begin DoDot:1

 +7                SET ORAMF1=$PIECE($GET(^DPT(ORAMDFN,.13)),"^")

                   SET ORAMF2=$PIECE($GET(^DPT(ORAMDFN,.13)),"^",2)

 +8                SET ORAMFC=$PIECE($GET(^DPT(ORAMDFN,.13)),"^",4)

                   SET ORAMP=$PIECE($GET(^DPT(ORAMDFN,.13)),"^",5)

                   SET ORAMEM=$PIECE($GET(^DPT(ORAMDFN,.13)),"^",3)

               End DoDot:1

 +9        IF ORAMT=1

               Begin DoDot:1

 +10               SET ORAMF1=$PIECE($GET(^DPT(ORAMDFN,.121)),"^",10)

                   SET ORAMF2=$PIECE($GET(^DPT(ORAMDFN,.13)),"^",2)

 +11               SET ORAMFC=$PIECE($GET(^DPT(ORAMDFN,.13)),"^",4)

                   SET ORAMP=$PIECE($GET(^DPT(ORAMDFN,.13)),"^",5)

                   SET ORAMEM=$PIECE($GET(^DPT(ORAMDFN,.13)),"^",3)

               End DoDot:1

 +12       SET RESULT=$GET(ORAMF1)_"^"_$GET(ORAMF2)_"^"_$GET(ORAMFC)_"^"_$GET(ORAMP)_"^"_$GET(ORAMEM)_"^"_$GET(ORAMT)

 +13       QUIT 

 +14      ;

TMPCHK(ORAMDFN) ;

 +1       ;;

 +2        NEW ORAMTMP

           SET ORAMTMP=0

 +3        IF $DATA(^DPT(ORAMDFN,.121))

               IF $PIECE(^DPT(ORAMDFN,.121),"^",9)="Y"

                   Begin DoDot:1

 +4       ;START DATE

                       if $PIECE(^DPT(ORAMDFN,.121),"^",7)>DT

                           QUIT 

 +5       ;END DATE

                       IF $PIECE(^DPT(ORAMDFN,.121),"^",8)'=""

                           if DT>$PIECE(^DPT(ORAMDFN,.121),"^",8)

                               QUIT 

 +6                    SET ORAMTMP=1

                   End DoDot:1

 +7        QUIT ORAMTMP

 +8       ;RSF 10/08/08  CHANGE TO CODE DUE TO NEWLY DISCOVERED PROBLEM WITH 'COMPLICATIONS'

COMPENT(RESULT,ORAMDFN,ORAMDUZ,ORAMC,ORAMCT,ORAMD2) ;

 +1       ;RPC=ORAM3 COMPLICATION

 +2        if '+$GET(ORAMDFN)

               QUIT 

 +3        if '$GET(ORAMDUZ)

               QUIT 

 +4        if '+$GET(ORAMC)

               QUIT 

 +5        if $GET(ORAMD2)=""

               QUIT 

 +6        NEW ORAMD3,ORAMX

           DO DT^DILF(,ORAMD2,.ORAMX)

           SET ORAMD3=ORAMX

 +7        NEW ORAMNOW,ORAMDAY,X,%

           DO NOW^%DTC

           SET ORAMNOW=%

           SET ORAMDAY=X

 +8        NEW ORAMNX

           SET ORAMNX=$ORDER(^ORAM(103,ORAMDFN,3," "),-1)+1

 +9        NEW ORAMC2,ORAMLLOC,ORAMPS,ORAMDD,ORAMTWD,ORAML,OERR

 +10       IF '$GET(ORAMNX)

               SET ORAMNX=1

 +11       IF ORAMNX>1

               Begin DoDot:1

 +12               SET ORAML=ORAMNX-1

                   SET ORAMLLOC=$PIECE(^ORAM(103,ORAMDFN,3,ORAML,0),"^",4)

                   SET ORAMPS=$PIECE(^(0),"^",5)

                   SET ORAMTWD=$PIECE(^(0),"^",6)

                   SET ORAMDD=$PIECE(^(0),"^",7)

               End DoDot:1

 +13      ;CLOT in the 100 range...I P1>100,P1#100>0 S P1=3 Q

           IF ORAMC>99

               SET ORAMC2=2

 +14      ;MAJOR BLEED I P1>99 S P1=2 Q

           IF ORAMC#10>0

               SET ORAMC2=1

 +15      ;MINOR BLEED

           IF ORAMC=10

               SET ORAMC2=3

 +16       NEW DA,IENS,ORAMRSF,ORAMF

 +17       SET IENS="+1,"_ORAMDFN_","

 +18       SET DA=ORAMNX

           SET DA(1)=ORAMDFN

 +19      ;COMPLICATION DATE

           SET ORAMRSF(103.011,IENS,.01)=ORAMD3

 +20      ;LAB DRAW LOC

           SET ORAMRSF(103.011,IENS,30)=ORAMLLOC

 +21      ;PILL STRENGTH

           SET ORAMRSF(103.011,IENS,40)=ORAMPS

 +22      ;TOTAL WEEK DOSE

           SET ORAMRSF(103.011,IENS,50)=ORAMTWD

 +23      ;DAILY DOSING

           SET ORAMRSF(103.011,IENS,60)=ORAMDD

 +24       SET ORAMRSF(103.011,IENS,80)=ORAMNOW

 +25      ;PROVIDER

           SET ORAMRSF(103.011,IENS,90)=ORAMDUZ

 +26      ;COMPLICATION CODE

           SET ORAMRSF(103.011,IENS,104)=ORAMC2

 +27       KILL ORAMF

 +28       SET ORAMF(ORAMNX)=DA

 +29       KILL OERR

 +30       DO UPDATE^DIE("","ORAMRSF","ORAMF","OERR")

 +31       SET ^ORAM(103,ORAMDFN,3,ORAMNX,2,1,0)=ORAMD2

 +32       IF $LENGTH(ORAMCT,"^")>0

               NEW ORAMCC

               FOR ORAMCC=1:1:$LENGTH(ORAMCT,"^")

                   Begin DoDot:1

 +33                   SET ^ORAM(103,ORAMDFN,3,ORAMNX,2,ORAMCC+1,0)=$PIECE(ORAMCT,"^",ORAMCC)

                   End DoDot:1

                   SET ^ORAM(103,ORAMDFN,3,ORAMNX,2,0)="^^"_ORAMCC_"^"_ORAMCC_"^"_ORAMDAY_"^"

 +34       SET RESULT=1

 +35       QUIT 

 +36      ;

TLISTS    ; Erases and sets Team Lists for Anticoagulation Clinics

 +1       ; Option: ORAM SET TEAMS

 +2       ;ARRAYS OF TEAMS

           NEW ORAMLIST

 +3        DO FTL(.ORAMLIST)

 +4       ;No lists defined

           IF '$DATA(ORAMLIST)

               QUIT 

 +5       ;ERASE ALL TEAM LISTS

           DO ETEAM(.ORAMLIST)

 +6       ;FORM TODAY'S TEAM LISTS

           DO MTEAM(.ORAMLIST)

 +7        QUIT 

 +8       ;

FTL(ORAMLIST) ;FIND TEAM LISTS  CALLED FROM TLISTS

 +1       ;

 +2        NEW ORAMI,ORAMCLST

           SET ORAMI=0

 +3        DO GETCLINS^ORAMSET(.ORAMCLST)

 +4       ;Site not SET UP

           IF +$GET(ORAMCLST(0))'>0

               QUIT 

 +5       ; Loop through Clinics, get team lists for each

 +6        FOR 

               SET ORAMI=$ORDER(ORAMCLST(ORAMI))

               if +ORAMI'>0

                   QUIT 

               Begin DoDot:1

 +7                NEW ORAMCL,ORAMALL,ORAMCPLX

 +8                SET ORAMCL=$PIECE($GET(ORAMCLST(ORAMI)),U,2)

                   if +ORAMCL'>0

                       QUIT 

 +9                SET ORAMALL=$$GET^XPAR(ORAMCL,"ORAM TEAM LIST (ALL)",1,"I")

 +10               if ORAMALL]""

                       SET ORAMLIST(ORAMCL,"ALL")=ORAMALL

 +11               SET ORAMCPLX=$$GET^XPAR(ORAMCL,"ORAM TEAM LIST (COMPLEX)",1,"I")

 +12               if ORAMCPLX]""

                       SET ORAMLIST(ORAMCL,"COMPLEX")=ORAMCPLX

               End DoDot:1

 +13       QUIT 

 +14      ;

ETEAM(ORAMLIST) ; Remove all Anticoagulation Patients from their respective lists

 +1       ; called from TLISTS

 +2        NEW ORAMI

           SET ORAMI=""

 +3        FOR 

               SET ORAMI=$ORDER(ORAMLIST(ORAMI))

               if ORAMI']""

                   QUIT 

               Begin DoDot:1

 +4                NEW ORAML

                   SET ORAML=""

 +5                FOR 

                       SET ORAML=$ORDER(ORAMLIST(ORAMI,ORAML))

                       if ORAML']""

                           QUIT 

                       Begin DoDot:2

 +6                        NEW DO,DA,DIK

 +7                        SET DA(1)=ORAMLIST(ORAMI,ORAML)

                           SET DIK="^OR(100.21"_","_DA(1)_",10,"

 +8                        SET DA=0

                           FOR 

                               SET DA=$ORDER(^OR(100.21,DA(1),10,DA))

                               if +DA'>0

                                   QUIT 

                               Begin DoDot:3

 +9                                DO ^DIK

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +10       QUIT 

 +11      ;

MTEAM(ORAMLIST) ; Build Today's Team Lists

 +1       ; CALLED FROM TLISTS

 +2        NEW ORAMCL

           SET ORAMCL=""

 +3       ; Loop through ORAMLIST by clinic location

 +4        FOR 

               SET ORAMCL=$ORDER(ORAMLIST(ORAMCL))

               if ORAMCL']""

                   QUIT 

               Begin DoDot:1

 +5                NEW ORAMCN,ORAMCA,ORAMCC,ORAMDFN

 +6       ; Pointer to file 44

                   SET ORAMCN=+ORAMCL

 +7       ; Pointer to "All" List

                   SET ORAMCA=$GET(ORAMLIST(ORAMCL,"ALL"))

 +8       ; Pointer to "Complex" List

                   SET ORAMCC=$GET(ORAMLIST(ORAMCL,"COMPLEX"))

 +9       ; Loop through Anticoagulation Patients by location

 +10               SET ORAMDFN=0

 +11               FOR 

                       SET ORAMDFN=$ORDER(^ORAM(103,"CL",ORAMCN,ORAMDFN))

                       if +ORAMDFN'>0

                           QUIT 

                       Begin DoDot:2

 +12                       NEW ORAMD0,ORAMRDT,ORAMCPLX,ORAMNDCB,ORAMAXDT

 +13                       SET ORAMD0=$GET(^ORAM(103,ORAMDFN,0))

 +14      ; Pt's Return Date

                           SET ORAMRDT=$PIECE(ORAMD0,U,4)

 +15      ; Upper bound for return date range

                           SET ORAMAXDT=DT_".2359"

 +16      ; Pt's Complexity

                           SET ORAMCPLX=$PIECE(ORAMD0,U,10)

 +17      ; Next Day Callback

                           SET ORAMNDCB=$PIECE(ORAMD0,U,20)

 +18      ; if next day callback, increment return date, disregard time

 +19                       IF +ORAMNDCB

                               SET ORAMRDT=$$FMADD^XLFDT($PIECE(ORAMRDT,"."),1)

 +20      ; if future return date or pt inactive, quit to next pt

 +21                       IF (ORAMRDT>ORAMAXDT)!(ORAMCPLX=2)

                               QUIT 

 +22      ; otherwise, add pt to appropriate list(s) for location

 +23      ; All active pts on "ALL" List

                           DO ADDLIST(ORAMDFN,ORAMCA)

 +24      ; Complex pts also on "COMPLEX" List

                           IF ORAMCPLX=1

                               DO ADDLIST(ORAMDFN,ORAMCC)

                       End DoDot:2

               End DoDot:1

 +25       QUIT 

ADDLIST(ORAMDFN,ORAMLDA) ; Add pt to Team List / Assure record is UNLOCKED

 +1        NEW DIC,DA,DO,X,ORAMLR

 +2        SET X=ORAMDFN_";DPT("

 +3        SET DA(1)=ORAMLDA

           SET DIC="^OR(100.21"_","_DA(1)_",10,"

           SET DIC(0)="L"

           DO FILE^DICN

 +4        DO UNLOCK^ORAM1(.ORAMLR,ORAMDFN)

 +5        QUIT