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

ORWU2.m

Go to the documentation of this file. 
  1. ORWU2 ;SLC/JEH - General Utilities for Windows Calls [2/25/04 11:10am]
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
  1.  ;
  1.  Q
  1.  ;
  1.  ; Return a set of names from the NEW PERSON file.
  1. COSIGNER(ORY,ORFROM,ORDIR,ORDATE,ORTIUTYP,ORTIUDA) ;
  1.  ; (Set up for the DC Summary)
  1.  ;  (to use TIU doc requirments and USR PROVIDER)
  1.  ;
  1.  ; PARAMS from ORWU2 COSIGNER RPC call:
  1.  ;  .ORY=returned list.
  1.  ;  ORFROM=Starting name for this set.  
  1.  ;  ORDIR=Direction to move through the x-ref with $O.  
  1.  ;  ORDATE=Checks for an USR PROVIDER on this date (optional).
  1.  ;  ORTIUTYP is + of the 0 node of the 8925 docmt.  
  1.  ;  ORTIUDA is the docmt IEN,
  1.  ;  
  1.  ;  
  1.  ;  
  1.  N ORDD,ORDIV,ORDUP,ORGOOD,ORI,ORIEN1,ORIEN2,ORLAST,ORMAX,ORMRK,ORMULTI,ORPREV,ORSRV,ORTTL,ORERR
  1.  ;
  1.  S ORI=0,ORMAX=44,(ORLAST,ORPREV)="",ORDATE=$G(ORDATE) ;ORKEY=$G(ORKEY)
  1.  I +$G(ORTIUDA) S ORTIUTYP=+$G(^TIU(8925,+$G(ORTIUDA),0))
  1.  S ORMULTI=$$ALL^VASITE ; IA# 10112.  Do once at beginning of call.
  1.  ;
  1.  F  Q:ORI'<ORMAX  S ORFROM=$O(^VA(200,"AUSER",ORFROM),ORDIR) Q:ORFROM=""  D
  1.  .S ORIEN1=""
  1.  .F  S ORIEN1=$O(^VA(200,"AUSER",ORFROM,ORIEN1),ORDIR) Q:'ORIEN1  D
  1.  ..;
  1.  ..I '$$PROVIDER^XUSER(ORIEN1,1) Q   ; Terminated? 
  1.  ..I '$$ISA^USRLM(+ORIEN1,"PROVIDER",.ORERR,ORDATE) Q  ;(USR PROVIDER CLASS CHECK?)
  1. TIU .. I $$REQCOSIG^TIULP(ORTIUTYP,ORTIUDA,ORIEN1,ORDATE) Q  ; User requiers cosigner 
  1.  ..;I ($L(ORKEY)),(ORKEY'="COSIGNER"),('$D(^XUSEC(ORKEY,+ORIEN1))) Q       ; Check for key?
  1.  ..;I ORDATE>0,$$GET^XUA4A72(ORIEN1,ORDATE)<1 Q    ; Check date? 
  1.  ..S ORI=ORI+1,ORY(ORI)=ORIEN1_"^"_$$NAMEFMT^XLFNAME(ORFROM,"F","DcMPC")
  1.  ..S ORDUP=0                            ; Init flag, check dupe.
  1.  ..I ($P(ORPREV_" "," ")=$P(ORFROM_" "," ")) S ORDUP=1
  1.  ..;
  1.  ..; Append Title if not duplicated:
  1.  ..I 'ORDUP D
  1.  ...S ORIEN2=ORIEN1
  1.  ...D COS4(0)                            ; Get Title. 
  1.  ...I ORTTL="" Q
  1.  ...S ORY(ORI)=ORY(ORI)_U_"- "_ORTTL
  1.  ..;
  1.  ..; Get data in case of dupes:
  1.  ..I ORDUP D
  1.  ...S ORIEN2=ORLAST                     ; Prev IEN for NP2 call.
  1.  ...;
  1.  ...; Reset, use previous array element, call for extended data:
  1.  ...S ORI=ORI-1,ORY(ORI)=$P(ORY(ORI),U)_U_$P(ORY(ORI),U,2)  D COS2
  1.  ...;
  1.  ...; Then return to current user for second extended data call:
  1.  ...S ORIEN2=ORIEN1,ORI=ORI+1  D COS2
  1.  ..S ORLAST=ORIEN1,ORPREV=ORFROM        ; Reassign vars for next pass.
  1.  ;
  1. END Q
  1.  ;
  1. COS2 ; Retrieve subset of data for dupes in COSIGNER.
  1.  ; (Assumes certain vars already set/new'd in calling code.)
  1.  ;
  1.  ; Variables used:
  1.  ;   ORZ    = Memory array storage variable.
  1.  ;   ORZERR = Error storage for LIST^DIC call.
  1.  ;
  1.  N ORZ,ORZERR                           ; Initialize variables.
  1.  S ORDIV=""                             ; Reset each time.
  1.  D COS4(1)                               ; Get Title, Service/Section.
  1.  ;
  1.  ; For multi-divisional site, get Division if determinable:
  1.  I ORMULTI D
  1.  .D LIST^DIC(200.02,","_ORIEN2_",","@;.01;1","QP","","","","","","","ORZ","ORZERR")
  1.  .S (ORDD,ORGOOD)=0                     ; Initialize variables.
  1.  .I $P(ORZ("DILIST",0),U)=0 Q           ; Division not listed.
  1.  .I $P(ORZ("DILIST",0),U)=1 D  Q        ; Only one, so use it.
  1.  ..S ORDD=$O(ORZ("DILIST",ORDD))        ; Get the node's entry.
  1.  ..S ORDIV=$P(ORDD,U,2)                 ; Get actual name value.
  1.  .;
  1.  .; More than one Division entry, so:
  1.  .F  S ORDD=$O(ORZ("DILIST",ORDD)) Q:+ORDD=0!'($L(ORDD))  D  Q:ORGOOD
  1.  ..;
  1.  ..; See if current entry being processed is "Default" (done if so):
  1.  ..I $P(ORZ("DILIST",ORDD,0),U,3)["Y" S ORDIV=$P(ORZ("DILIST",ORDD,0),U,2),ORGOOD=1  Q                       ; Division text.
  1.  ;
  1.  ; Append new pieces to array string:
  1.  S ORMRK=""
  1.  I (ORTTL="")&(ORSRV="")&(ORDIV="")  Q  ; Nothing to append.
  1.  S ORY(ORI)=ORY(ORI)_U_"- "             ; At least something exists.
  1.  I (ORTTL'="") S ORY(ORI)=ORY(ORI)_ORTTL,ORMRK=", "       ; Title.
  1.  I (ORSRV'="") S ORY(ORI)=ORY(ORI)_ORMRK_ORSRV,ORMRK=", " ; Service.
  1.  I (ORDIV'="") S ORY(ORI)=ORY(ORI)_ORMRK_ORDIV            ; Division.
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. COS4(ORSS) ; Retrieve Title or Title and Service/Section.
  1.  ; (Assumes certain vars already set/new'd in calling code.)
  1.  ;
  1.  ; Passed variable ORSS: If true, get Service/Section also.
  1.  ;
  1.  S (ORTTL,ORSRV)=""                            ; Init each time.
  1.  ; DBIA# 4329:
  1.  S ORTTL=$P($G(^VA(200,ORIEN2,0)),U,9)         ; Get Title pointer.
  1.  I ORTTL<1 S ORTTL=""                          ; Reset var if none.
  1.  ; DBIA# 1234:
  1.  I ORTTL>0 S ORTTL=$G(^DIC(3.1,ORTTL,0))       ; Actual Title value.
  1.  S ORSS=$G(ORSS)
  1.  I ORSS D                                      ; Get Service/Section?
  1.  .; DBIA# 4329:
  1.  .S ORSRV=$P($G(^VA(200,ORIEN2,5)),U,1)        ; Get S/S pointer.
  1.  .I ORSRV<1 S ORSRV=""                         ; Reset var if none.
  1.  .; DBIA# 4330:
  1.  .I ORSRV>0 S ORSRV=$P($G(^DIC(49,ORSRV,0)),U) ; Actual S/S value.
  1.  ;
  1.  Q
  1.  ;