ORWU1 ;SLC/GRE - General Utilities for Windows Calls [2/25/04 11:10am]
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**149,187,195,215**;Dec 17, 1997
 ;
 Q
 ;
NP1 ; Return a set of names from the NEW PERSON file.
 ; (PKS/8/5/2003: Now called by NEWPERS^ORWU; internal mods made.)
 ; (Keep GETCOS^ORWTPN up to date with matching logic/code, too.)
 ;
 ; PARAMS from NEWPERS^ORWU call:
 ;  .ORY=returned list.
 ;  ORDATE=Checks for an active person class on this date (optional).
 ;  ORDIR=Direction to move through the x-ref with $O.  
 ;  ORFROM=Starting name for this set.
 ;  ORKEY=Screen users by security key (optional).
 ;  ORVIZ=If true, includes RDV users; otherwise not (optional).
 ;  
 N ORDD,ORDIV,ORDUP,ORGOOD,ORI,ORIEN1,ORIEN2,ORLAST,ORMAX,ORMRK,ORMULTI,ORPREV,ORSRV,ORTTL
 ;
 S ORI=0,ORMAX=44,(ORLAST,ORPREV)="",ORKEY=$G(ORKEY),ORDATE=$G(ORDATE)
 S ORMULTI=$$ALL^VASITE ; IA# 10112.  Do once at beginning of call.
 ;
 ; NP3 tag includes visitors, uses full "B" x-ref.
 I +$G(ORVIZ)=1 D NP3(0) Q  ; Use alt. version, skip rest.
 ; User requested ALL users, both active and inactive.  Same call, but skip $$PROVIDER^XUSER screen
 I +$G(ORALL)=1 D NP3(0) Q
 ;
 F  Q:ORI'<ORMAX  S ORFROM=$O(^VA(200,"AUSER",ORFROM),ORDIR) Q:ORFROM=""  D
 .S ORIEN1=""
 .F  S ORIEN1=$O(^VA(200,"AUSER",ORFROM,ORIEN1),ORDIR) Q:'ORIEN1  D
 ..;
 ..I $L(ORKEY),'$D(^XUSEC(ORKEY,+ORIEN1)) Q       ; Check for key?
 ..I ORDATE>0,$$GET^XUA4A72(ORIEN1,ORDATE)<1 Q    ; Check date?
 ..S ORI=ORI+1,ORY(ORI)=ORIEN1_"^"_$$NAMEFMT^XLFNAME(ORFROM,"F","DcMPC")
 ..S ORDUP=0                            ; Init flag, check dupe.
 ..I ($P(ORPREV_" "," ")=$P(ORFROM_" "," ")) S ORDUP=1
 ..;
 ..; Append Title if not duplicated:
 ..I 'ORDUP D
 ...S ORIEN2=ORIEN1
 ...D NP4(0)                            ; Get Title. 
 ...I ORTTL="" Q
 ...S ORY(ORI)=ORY(ORI)_U_"- "_ORTTL
 ..;
 ..; Get data in case of dupes:
 ..I ORDUP D
 ...S ORIEN2=ORLAST                     ; Prev IEN for NP2 call.
 ...;
 ...; Reset, use previous array element, call for extended data:
 ...S ORI=ORI-1,ORY(ORI)=$P(ORY(ORI),U)_U_$P(ORY(ORI),U,2)  D NP2
 ...;
 ...; Then return to current user for second extended data call:
 ...S ORIEN2=ORIEN1,ORI=ORI+1  D NP2
 ..S ORLAST=ORIEN1,ORPREV=ORFROM        ; Reassign vars for next pass.
 ;
 Q
 ;
NP2 ; Retrieve subset of data for dupes in NP1.
 ; (Assumes certain vars already set/new'd in calling code.)
 ;
 ; Variables used:
 ;   ORZ    = Memory array storage variable.
 ;   ORZERR = Error storage for LIST^DIC call.
 ;
 N ORZ,ORZERR                           ; Initialize variables.
 S ORDIV=""                             ; Reset each time.
 D NP4(1)                               ; Get Title, Service/Section.
 ;
 ; For multi-divisional site, get Division if determinable:
 I ORMULTI D
 .D LIST^DIC(200.02,","_ORIEN2_",","@;.01;1","QP","","","","","","","ORZ","ORZERR")
 .S (ORDD,ORGOOD)=0                     ; Initialize variables.
 .I $P(ORZ("DILIST",0),U)=0 Q           ; Division not listed.
 .I $P(ORZ("DILIST",0),U)=1 D  Q        ; Only one, so use it.
 ..S ORDD=$O(ORZ("DILIST",ORDD))        ; Get the node's entry.
 ..S ORDIV=$P(ORDD,U,2)                 ; Get actual name value.
 .;
 .; More than one Division entry, so:
 .F  S ORDD=$O(ORZ("DILIST",ORDD)) Q:+ORDD=0!'($L(ORDD))  D  Q:ORGOOD
 ..;
 ..; See if current entry being processed is "Default" (done if so):
 ..I $P(ORZ("DILIST",ORDD,0),U,3)["Y" S ORDIV=$P(ORZ("DILIST",ORDD,0),U,2),ORGOOD=1  Q                       ; Division text.
 ;
 ; Append new pieces to array string:
 S ORMRK=""
 I (ORTTL="")&(ORSRV="")&(ORDIV="")  Q  ; Nothing to append.
 S ORY(ORI)=ORY(ORI)_U_"- "             ; At least something exists.
 I (ORTTL'="") S ORY(ORI)=ORY(ORI)_ORTTL,ORMRK=", "       ; Title.
 I (ORSRV'="") S ORY(ORI)=ORY(ORI)_ORMRK_ORSRV,ORMRK=", " ; Service.
 I (ORDIV'="") S ORY(ORI)=ORY(ORI)_ORMRK_ORDIV            ; Division.
 ;
 Q
 ;
NP3(COSFLAG) ; Retrieve diff. data when all users are involved, using "B" x-ref.
 ;
 ; COSFLAG=If TRUE, called by ORWTPN.
 ; (Assumes certain vars already set/new'd in calling code.)
 ;
 N ORNODE,COSQUIT
 S COSQUIT=0 ; Flag used in section for COSFLAG.
 ;
 F  Q:ORI'<ORMAX  S ORFROM=$O(^VA(200,"B",ORFROM),ORDIR) Q:ORFROM=""  D
 .S ORIEN1=""
 .F  S ORIEN1=$O(^VA(200,"B",ORFROM,ORIEN1),ORDIR) Q:'ORIEN1  D
 ..;
 ..; Screen default cosigner if appropriate (ORUSER set in ORWTPN):
 ..I COSFLAG D
 ...S COSQUIT=0
 ...I '$$SCRDFCS^TIULA3(ORUSER,ORIEN1) S COSFLAG=1 Q
 ...S ORNODE=$P($G(^VA(200,ORIEN1,0)),U)
 ...I '$L(ORNODE) S COSFLAG=1 Q
 ..I COSQUIT Q
 ..;
 ..I +$G(ORALL)=0,'$$PROVIDER^XUSER(ORIEN1,1) Q   ; Terminated?   Skip if ALL requested
 ..I ORDATE>0,$$GET^XUA4A72(ORIEN1,ORDATE)<1 Q    ; Check date?
 ..I $L(ORKEY),'$D(^XUSEC(ORKEY,+ORIEN1)) Q       ; Check for key?
 ..S ORI=ORI+1,ORY(ORI)=ORIEN1_"^"_$$NAMEFMT^XLFNAME(ORFROM,"F","DcMPC")
 ..S ORDUP=0                           ; Init flag, check duplication.
 ..I ($P(ORPREV_" "," ")=$P(ORFROM_" "," ")) S ORDUP=1
 ..;
 ..; Append Title if not duplicated:
 ..I 'ORDUP D
 ...S ORIEN2=ORIEN1
 ...D NP4(0)                           ; Get Title. 
 ...I ORTTL="" Q
 ...S ORY(ORI)=ORY(ORI)_U_"- "_ORTTL
 ..;
 ..; Get data in case of dupes:
 ..I ORDUP D
 ...S ORIEN2=ORLAST                   ; Set to prev. IEN for NP2.
 ...;
 ...; Reset, use previous array element, call for extended data:
 ...S ORI=ORI-1,ORY(ORI)=$P(ORY(ORI),U)_U_$P(ORY(ORI),U,2)  D NP2
 ...;
 ...; Now return to current user for second extended data call:
 ...S ORIEN2=ORIEN1,ORI=ORI+1  D NP2
 ..S ORLAST=ORIEN1,ORPREV=ORFROM       ; Reassign vars for next pass.
 ;
 Q
 ;
NP4(ORSS) ; Retrieve Title or Title and Service/Section.
 ; (Assumes certain vars already set/new'd in calling code.)
 ;
 ; Passed variable ORSS: If true, get Service/Section also.
 ;
 S (ORTTL,ORSRV)=""                            ; Init each time.
 ; DBIA# 4329:
 S ORTTL=$P($G(^VA(200,ORIEN2,0)),U,9)         ; Get Title pointer.
 I ORTTL<1 S ORTTL=""                          ; Reset var if none.
 ; DBIA# 1234:
 I ORTTL>0 S ORTTL=$G(^DIC(3.1,ORTTL,0))       ; Actual Title value.
 S ORSS=$G(ORSS)
 I ORSS D                                      ; Get Service/Section?
 .; DBIA# 4329:
 .S ORSRV=$P($G(^VA(200,ORIEN2,5)),U,1)        ; Get S/S pointer.
 .I ORSRV<1 S ORSRV=""                         ; Reset var if none.
 .; DBIA# 4330:
 .I ORSRV>0 S ORSRV=$P($G(^DIC(49,ORSRV,0)),U) ; Actual S/S value.
 ;
 Q
 ;
NAMECVT(Y,IEN) ; Returns text name(mixed-case) derived from IEN xref.
 ; GRE/2002
 ; PKS-12/20/2002 Tag not presently used.
 ; Y=Returned value, IEN=Internal number
 N ORNAME
 S IEN=IEN_","
 S ORNAME=$$GET1^DIQ(200,IEN,20.2)
 S Y=$$NAMEFMT^XLFNAME(.ORNAME,"F","DcMPC")
 Q
 ;
DEFDIV(Y) ; Return user's default division, if specified.
 ;
 ; Variables used:
 ;   ORDD   = Default division.
 ;   ORDIV  = Division holder variable.
 ;   ORGOOD = Flag for successful default division found.
 ;   ORIEN  = IEN of user.
 ;   ORZ    = Memory array storage variable.
 ;   ORZERR = Error storage for LIST^DIC call.
 ;   Y      = Returned value.
 ;
 N ORDD,ORDIV,ORGOOD,ORIEN,ORZ,ORZERR
 ;
 S ORIEN=DUZ,ORDIV=""
 S Y=0,(ORDD,ORGOOD)=0             ; Initialize variables.
 ;
 ; Get list of divisions from NEW PERSON file multiple:
 D LIST^DIC(200.02,","_ORIEN_",","@;.01;1","QP","","","","","","","ORZ","ORZERR")
 I $P(ORZ("DILIST",0),U)=0 Q       ; No Divisions listed.
 ;
 ; Iterate through list:
 F  S ORDD=$O(ORZ("DILIST",ORDD)) Q:+ORDD=0!'($L(ORDD))  D  Q:ORGOOD
 .;
 .; See if current entry being processed is "Default" (done if so):
 .I $P(ORZ("DILIST",ORDD,0),U,3)["Y" S ORDIV=$P(ORZ("DILIST",ORDD,0),U,2),ORGOOD=1                      ; Division text.
 .;
 I (ORDIV="") Q                    ; Punt if no default division.
 I $$UP^XLFSTR(ORDIV)="SALT LAKE CITY OIFO" S Y=1
 ;
 Q
 ;
NEWLOC(Y,ORFROM,DIR) ; Return "CZ" locations from HOSPITAL LOCATION file.
 ; C=Clinics, Z=Other, screened by $$ACTLOC^ORWU.
 ; .Y=returned list, ORFROM=text to $O from, DIR=$O direction.
 N I,IEN,CNT S I=0,CNT=44
 F  Q:I'<CNT  S ORFROM=$O(^SC("B",ORFROM),DIR) Q:ORFROM=""  D  ; IA# 10040.
 . S IEN="" F  S IEN=$O(^SC("B",ORFROM,IEN),DIR) Q:'IEN  D
 . . Q:("C"'[$P($G(^SC(IEN,0)),U,3)!('$$ACTLOC^ORWU(IEN)))
 . . S I=I+1,Y(I)=IEN_"^"_ORFROM
 Q
 ;