| 1 | ORWU2 ;SLC/JEH - General Utilities for Windows Calls [2/25/04 11:10am]
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ; Return a set of names from the NEW PERSON file.
|
|---|
| 7 | COSIGNER(ORY,ORFROM,ORDIR,ORDATE,ORTIUTYP,ORTIUDA) ;
|
|---|
| 8 | ; (Set up for the DC Summary)
|
|---|
| 9 | ; (to use TIU doc requirments and USR PROVIDER)
|
|---|
| 10 | ;
|
|---|
| 11 | ; PARAMS from ORWU2 COSIGNER RPC call:
|
|---|
| 12 | ; .ORY=returned list.
|
|---|
| 13 | ; ORFROM=Starting name for this set.
|
|---|
| 14 | ; ORDIR=Direction to move through the x-ref with $O.
|
|---|
| 15 | ; ORDATE=Checks for an USR PROVIDER on this date (optional).
|
|---|
| 16 | ; ORTIUTYP is + of the 0 node of the 8925 docmt.
|
|---|
| 17 | ; ORTIUDA is the docmt IEN,
|
|---|
| 18 | ;
|
|---|
| 19 | ;
|
|---|
| 20 | ;
|
|---|
| 21 | N ORDD,ORDIV,ORDUP,ORGOOD,ORI,ORIEN1,ORIEN2,ORLAST,ORMAX,ORMRK,ORMULTI,ORPREV,ORSRV,ORTTL,ORERR
|
|---|
| 22 | ;
|
|---|
| 23 | S ORI=0,ORMAX=44,(ORLAST,ORPREV)="",ORDATE=$G(ORDATE) ;ORKEY=$G(ORKEY)
|
|---|
| 24 | I +$G(ORTIUDA) S ORTIUTYP=+$G(^TIU(8925,+$G(ORTIUDA),0))
|
|---|
| 25 | S ORMULTI=$$ALL^VASITE ; IA# 10112. Do once at beginning of call.
|
|---|
| 26 | ;
|
|---|
| 27 | F Q:ORI'<ORMAX S ORFROM=$O(^VA(200,"AUSER",ORFROM),ORDIR) Q:ORFROM="" D
|
|---|
| 28 | .S ORIEN1=""
|
|---|
| 29 | .F S ORIEN1=$O(^VA(200,"AUSER",ORFROM,ORIEN1),ORDIR) Q:'ORIEN1 D
|
|---|
| 30 | ..;
|
|---|
| 31 | ..I '$$PROVIDER^XUSER(ORIEN1,1) Q ; Terminated?
|
|---|
| 32 | ..I '$$ISA^USRLM(+ORIEN1,"PROVIDER",.ORERR,ORDATE) Q ;(USR PROVIDER CLASS CHECK?)
|
|---|
| 33 | TIU .. I $$REQCOSIG^TIULP(ORTIUTYP,ORTIUDA,ORIEN1,ORDATE) Q ; User requiers cosigner
|
|---|
| 34 | ..;I ($L(ORKEY)),(ORKEY'="COSIGNER"),('$D(^XUSEC(ORKEY,+ORIEN1))) Q ; Check for key?
|
|---|
| 35 | ..;I ORDATE>0,$$GET^XUA4A72(ORIEN1,ORDATE)<1 Q ; Check date?
|
|---|
| 36 | ..S ORI=ORI+1,ORY(ORI)=ORIEN1_"^"_$$NAMEFMT^XLFNAME(ORFROM,"F","DcMPC")
|
|---|
| 37 | ..S ORDUP=0 ; Init flag, check dupe.
|
|---|
| 38 | ..I ($P(ORPREV_" "," ")=$P(ORFROM_" "," ")) S ORDUP=1
|
|---|
| 39 | ..;
|
|---|
| 40 | ..; Append Title if not duplicated:
|
|---|
| 41 | ..I 'ORDUP D
|
|---|
| 42 | ...S ORIEN2=ORIEN1
|
|---|
| 43 | ...D COS4(0) ; Get Title.
|
|---|
| 44 | ...I ORTTL="" Q
|
|---|
| 45 | ...S ORY(ORI)=ORY(ORI)_U_"- "_ORTTL
|
|---|
| 46 | ..;
|
|---|
| 47 | ..; Get data in case of dupes:
|
|---|
| 48 | ..I ORDUP D
|
|---|
| 49 | ...S ORIEN2=ORLAST ; Prev IEN for NP2 call.
|
|---|
| 50 | ...;
|
|---|
| 51 | ...; Reset, use previous array element, call for extended data:
|
|---|
| 52 | ...S ORI=ORI-1,ORY(ORI)=$P(ORY(ORI),U)_U_$P(ORY(ORI),U,2) D COS2
|
|---|
| 53 | ...;
|
|---|
| 54 | ...; Then return to current user for second extended data call:
|
|---|
| 55 | ...S ORIEN2=ORIEN1,ORI=ORI+1 D COS2
|
|---|
| 56 | ..S ORLAST=ORIEN1,ORPREV=ORFROM ; Reassign vars for next pass.
|
|---|
| 57 | ;
|
|---|
| 58 | END Q
|
|---|
| 59 | ;
|
|---|
| 60 | COS2 ; Retrieve subset of data for dupes in COSIGNER.
|
|---|
| 61 | ; (Assumes certain vars already set/new'd in calling code.)
|
|---|
| 62 | ;
|
|---|
| 63 | ; Variables used:
|
|---|
| 64 | ; ORZ = Memory array storage variable.
|
|---|
| 65 | ; ORZERR = Error storage for LIST^DIC call.
|
|---|
| 66 | ;
|
|---|
| 67 | N ORZ,ORZERR ; Initialize variables.
|
|---|
| 68 | S ORDIV="" ; Reset each time.
|
|---|
| 69 | D COS4(1) ; Get Title, Service/Section.
|
|---|
| 70 | ;
|
|---|
| 71 | ; For multi-divisional site, get Division if determinable:
|
|---|
| 72 | I ORMULTI D
|
|---|
| 73 | .D LIST^DIC(200.02,","_ORIEN2_",","@;.01;1","QP","","","","","","","ORZ","ORZERR")
|
|---|
| 74 | .S (ORDD,ORGOOD)=0 ; Initialize variables.
|
|---|
| 75 | .I $P(ORZ("DILIST",0),U)=0 Q ; Division not listed.
|
|---|
| 76 | .I $P(ORZ("DILIST",0),U)=1 D Q ; Only one, so use it.
|
|---|
| 77 | ..S ORDD=$O(ORZ("DILIST",ORDD)) ; Get the node's entry.
|
|---|
| 78 | ..S ORDIV=$P(ORDD,U,2) ; Get actual name value.
|
|---|
| 79 | .;
|
|---|
| 80 | .; More than one Division entry, so:
|
|---|
| 81 | .F S ORDD=$O(ORZ("DILIST",ORDD)) Q:+ORDD=0!'($L(ORDD)) D Q:ORGOOD
|
|---|
| 82 | ..;
|
|---|
| 83 | ..; See if current entry being processed is "Default" (done if so):
|
|---|
| 84 | ..I $P(ORZ("DILIST",ORDD,0),U,3)["Y" S ORDIV=$P(ORZ("DILIST",ORDD,0),U,2),ORGOOD=1 Q ; Division text.
|
|---|
| 85 | ;
|
|---|
| 86 | ; Append new pieces to array string:
|
|---|
| 87 | S ORMRK=""
|
|---|
| 88 | I (ORTTL="")&(ORSRV="")&(ORDIV="") Q ; Nothing to append.
|
|---|
| 89 | S ORY(ORI)=ORY(ORI)_U_"- " ; At least something exists.
|
|---|
| 90 | I (ORTTL'="") S ORY(ORI)=ORY(ORI)_ORTTL,ORMRK=", " ; Title.
|
|---|
| 91 | I (ORSRV'="") S ORY(ORI)=ORY(ORI)_ORMRK_ORSRV,ORMRK=", " ; Service.
|
|---|
| 92 | I (ORDIV'="") S ORY(ORI)=ORY(ORI)_ORMRK_ORDIV ; Division.
|
|---|
| 93 | ;
|
|---|
| 94 | Q
|
|---|
| 95 | ;
|
|---|
| 96 | ;
|
|---|
| 97 | COS4(ORSS) ; Retrieve Title or Title and Service/Section.
|
|---|
| 98 | ; (Assumes certain vars already set/new'd in calling code.)
|
|---|
| 99 | ;
|
|---|
| 100 | ; Passed variable ORSS: If true, get Service/Section also.
|
|---|
| 101 | ;
|
|---|
| 102 | S (ORTTL,ORSRV)="" ; Init each time.
|
|---|
| 103 | ; DBIA# 4329:
|
|---|
| 104 | S ORTTL=$P($G(^VA(200,ORIEN2,0)),U,9) ; Get Title pointer.
|
|---|
| 105 | I ORTTL<1 S ORTTL="" ; Reset var if none.
|
|---|
| 106 | ; DBIA# 1234:
|
|---|
| 107 | I ORTTL>0 S ORTTL=$G(^DIC(3.1,ORTTL,0)) ; Actual Title value.
|
|---|
| 108 | S ORSS=$G(ORSS)
|
|---|
| 109 | I ORSS D ; Get Service/Section?
|
|---|
| 110 | .; DBIA# 4329:
|
|---|
| 111 | .S ORSRV=$P($G(^VA(200,ORIEN2,5)),U,1) ; Get S/S pointer.
|
|---|
| 112 | .I ORSRV<1 S ORSRV="" ; Reset var if none.
|
|---|
| 113 | .; DBIA# 4330:
|
|---|
| 114 | .I ORSRV>0 S ORSRV=$P($G(^DIC(49,ORSRV,0)),U) ; Actual S/S value.
|
|---|
| 115 | ;
|
|---|
| 116 | Q
|
|---|
| 117 | ;
|
|---|
