ORWU2 ; SLC/JEH,AJB - General Utilities for Windows Calls ;02/09/23 07:26
;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,533,539,596**;Dec 17, 1997;Build 7
;
; External reference to $$REQCOSIG^TIULP supported by IA 2322
; External reference to $$ISA^USRLM supported by IA 1544
;
Q
COSIGNER(ORY,ORFROM,ORDIR,ORDATE,ORTIUTYP,ORTIUDA,ORSIM) ; Return a set of names from the NEW PERSON file.
; (Set up for the DC Summary)
; (to use TIU doc requirments and USR PROVIDER)
;
; PARAMS from ORWU2 COSIGNER RPC call:
; .ORY=returned list.
; ORFROM=Starting name for this set.
; ORDIR=Direction to move through the x-ref with $O.
; ORDATE=Checks for an USR PROVIDER on this date (optional).
; ORTIUTYP is + of the 0 node of the 8925 docmt.
; ORTIUDA is the docmt IEN.
; ORSIM = If true, this indicates that this is a Similar Provider RPC call NSR#20110606 (539)
;
; *596 ajb
; ORTIUTYP is always passed in as 0 & ORTIUDA is the IEN of File #8925.1 [document definition]
I $$GET^XPAR("SYS","ORNEWPERS ACTIVE") D Q ; use new entry point^routine only if value is YES (default is YES)
. N I,PARAMS,PRM S PARAMS("HELP")=0,PRM(0)="FROM^DIR^DATE^TIUDA^TYPE^SPN"
. S PRM=$P($P($P($T(COSIGNER),"(",2),")"),",",2,$L($P($P($T(COSIGNER),"(",2),")"))) ; set string of parameters from NEWPERS
. F I=1:1:$L(PRM,",") S PARAMS($P(PRM(0),U,I))=$G(@($P(PRM,",",I))) ; set variables to pass by reference
. D NEWPERSON^ORNEWPERS(.ORY,.PARAMS)
; *596 ajb
;
N ORDD,ORDIV,ORDUP,ORGOOD,ORI,ORIEN1,ORIEN2,ORLAST,ORMAX,ORMRK,ORMULTI,ORNPI,ORPREV,ORSRV,ORTTL,ORERR
N ORFNM,ORFNMLEN,ORLNM,OPTIEN,ORDUPNM ; Add first and last names, the provider IEN and first name length
S ORI=0,ORMAX=44,(ORLAST,ORPREV,ORDUPNM)="",ORDATE=$G(ORDATE),ORSIM=$G(ORSIM)
S OPTIEN=$$LKOPT^XPDMENU("OR CPRS GUI CHART") ;Set IEN to option file for GUI Chart for Similar Provider calls
S ORMULTI=$$ALL^VASITE ; IA# 10112. Do once at beginning of call.
I +ORSIM D ; ** NSR 20110606/539 - If ORSIM, ORFROM is IEN and needs to be changed to name. Also get first name, its length and last name **
.N LASTCHAR,ORFIEN,ORFROM1,XFNM,XFNMLEN
.S ORFIEN=ORFROM
.S (ORFROM,ORFROM1)=$P(^VA(200,ORFROM,0),U),$P(ORFROM,",",2)=$E($P(ORFROM,",",2),1,2)
.S ORFNM=$P(ORFROM,",",2),ORFNMLEN=$L(ORFNM),ORLNM=$P(ORFROM,",") ; ** NSR 20110606/539 - Add ORFNM, ORFNMLEN and ORLNM **
.I ORFNM]"" D
..S XFNM=$P(ORFROM,",",2),XFNMLEN=$L(XFNM),LASTCHAR=$C($A(XFNM,XFNMLEN)-1),XFNM=$E(XFNM,1,XFNMLEN-1)_LASTCHAR_$C(126)
..S $P(ORFROM,",",2)=XFNM
.S ORI=ORI+1,ORY(ORI)=ORFIEN_"^"_$$NAMEFMT^XLFNAME(ORFROM1,"F","DcMPC")
.S ORDUPNM(ORFIEN)=""
.S ORIEN2=ORFIEN
.;Using COS2 instead of COS4(0) in case duplicate (same but different) entry found later
.D COS2
E D
.S (ORFNM,ORFNMLEN,ORLNM)=""
;
ND I +$G(ORTIUDA) S ORTIUTYP=+$G(^TIU(8925,+$G(ORTIUDA),0))
;
F Q:ORI'<ORMAX S ORFROM=$O(^VA(200,"AUSER",ORFROM),ORDIR) Q:ORFROM=""!'$$CHKORSIM(ORSIM,ORFNM,ORFNMLEN,ORFROM,ORLNM) D ;Check for quitting with ORSIM and names comparison (539)
.S ORIEN1=""
.F S ORIEN1=$O(^VA(200,"AUSER",ORFROM,ORIEN1),ORDIR) Q:'ORIEN1 D
..I $D(ORDUPNM(ORIEN1)) Q
..I '$$PROVIDER^XUSER(ORIEN1,1) Q ; Terminated?
..I '$$ISA^USRLM(+ORIEN1,"PROVIDER",.ORERR,ORDATE) Q ;(USR PROVIDER CLASS CHECK?)
TIU .. I $$REQCOSIG^TIULP(ORTIUTYP,ORTIUDA,ORIEN1,ORDATE) Q ; User requiers cosigner
..I ORSIM,('+$$ACCESS^XQCHK(ORIEN1,OPTIEN)!'$$FIND1^DIC(200.010113,","_ORIEN1_",","","COR")) Q ;Check if Similar Provider call
..;I ($L(ORKEY)),(ORKEY'="COSIGNER"),('$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 COS4(0) ; Get Title. *533 & NPI
...; add NPI data *533 ; ajb
...I ORTTL="" S ORY(ORI)=ORY(ORI)_U_ORNPI Q
...S ORY(ORI)=ORY(ORI)_U_"- "_ORTTL_ORNPI
...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 COS2
...;
...; Then return to current user for second extended data call:
...S ORIEN2=ORIEN1,ORI=ORI+1 D COS2
..S ORLAST=ORIEN1,ORPREV=ORFROM ; Reassign vars for next pass.
;
END Q
;
COS2 ; Retrieve subset of data for dupes in COSIGNER.
; (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 COS4(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="")&(ORNPI="") 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.
I (ORNPI'="") S ORY(ORI)=ORY(ORI)_ORNPI ; NPI *533
;
Q
;
;
COS4(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 (ORNPI,ORTTL,ORSRV)="" ; Init each time.
; DBIA# 4329:
S ORTTL=$P($G(^VA(200,ORIEN2,0)),U,9) ; Get Title pointer.
S ORNPI=+$$NPI^XUSNPI("Individual_ID",ORIEN2) ; Get NPI. *533 ICR#4532
S ORNPI=$S(ORNPI>0:" [NPI:"_ORNPI_"]",1:"")
I ORTTL<1 S ORTTL="" ; Reset var if none.
; DBIA# 1234:
I ORTTL>0 S ORTTL=$$TITLE^XLFSTR($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=$$TITLE^XLFSTR($P($G(^DIC(49,ORSRV,0)),U)) ; Actual S/S value.
;
Q
;
CHKORSIM(ORSIM,ORFNM,ORFNMLEN,ORFROM,ORLNM) ; If this is a Similiar Provider call check for matching names - 539
I 'ORSIM Q 1 ; If 'ORSIM, no additional restrictions
I $E(ORFROM,1,$L(ORLNM))'=ORLNM Q 0 ; If last names don't match, quit now
I $E($P(ORFROM,",",2),1,ORFNMLEN)'=ORFNM Q 0 ; If first name portions don't match, quit now
Q 1 ; All checks passed
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWU2 7764 printed Nov 22, 2024@17:47:39 Page 2
ORWU2 ; SLC/JEH,AJB - General Utilities for Windows Calls ;02/09/23 07:26
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,533,539,596**;Dec 17, 1997;Build 7
+2 ;
+3 ; External reference to $$REQCOSIG^TIULP supported by IA 2322
+4 ; External reference to $$ISA^USRLM supported by IA 1544
+5 ;
+6 QUIT
COSIGNER(ORY,ORFROM,ORDIR,ORDATE,ORTIUTYP,ORTIUDA,ORSIM) ; Return a set of names from the NEW PERSON file.
+1 ; (Set up for the DC Summary)
+2 ; (to use TIU doc requirments and USR PROVIDER)
+3 ;
+4 ; PARAMS from ORWU2 COSIGNER RPC call:
+5 ; .ORY=returned list.
+6 ; ORFROM=Starting name for this set.
+7 ; ORDIR=Direction to move through the x-ref with $O.
+8 ; ORDATE=Checks for an USR PROVIDER on this date (optional).
+9 ; ORTIUTYP is + of the 0 node of the 8925 docmt.
+10 ; ORTIUDA is the docmt IEN.
+11 ; ORSIM = If true, this indicates that this is a Similar Provider RPC call NSR#20110606 (539)
+12 ;
+13 ; *596 ajb
+14 ; ORTIUTYP is always passed in as 0 & ORTIUDA is the IEN of File #8925.1 [document definition]
+15 ; use new entry point^routine only if value is YES (default is YES)
IF $$GET^XPAR("SYS","ORNEWPERS ACTIVE")
Begin DoDot:1
+16 NEW I,PARAMS,PRM
SET PARAMS("HELP")=0
SET PRM(0)="FROM^DIR^DATE^TIUDA^TYPE^SPN"
+17 ; set string of parameters from NEWPERS
SET PRM=$PIECE($PIECE($PIECE($TEXT(COSIGNER),"(",2),")"),",",2,$LENGTH($PIECE($PIECE($TEXT(COSIGNER),"(",2),")")))
+18 ; set variables to pass by reference
FOR I=1:1:$LENGTH(PRM,",")
SET PARAMS($PIECE(PRM(0),U,I))=$GET(@($PIECE(PRM,",",I)))
+19 DO NEWPERSON^ORNEWPERS(.ORY,.PARAMS)
End DoDot:1
QUIT
+20 ; *596 ajb
+21 ;
+22 NEW ORDD,ORDIV,ORDUP,ORGOOD,ORI,ORIEN1,ORIEN2,ORLAST,ORMAX,ORMRK,ORMULTI,ORNPI,ORPREV,ORSRV,ORTTL,ORERR
+23 ; Add first and last names, the provider IEN and first name length
NEW ORFNM,ORFNMLEN,ORLNM,OPTIEN,ORDUPNM
+24 SET ORI=0
SET ORMAX=44
SET (ORLAST,ORPREV,ORDUPNM)=""
SET ORDATE=$GET(ORDATE)
SET ORSIM=$GET(ORSIM)
+25 ;Set IEN to option file for GUI Chart for Similar Provider calls
SET OPTIEN=$$LKOPT^XPDMENU("OR CPRS GUI CHART")
+26 ; IA# 10112. Do once at beginning of call.
SET ORMULTI=$$ALL^VASITE
+27 ; ** NSR 20110606/539 - If ORSIM, ORFROM is IEN and needs to be changed to name. Also get first name, its length and last name **
IF +ORSIM
Begin DoDot:1
+28 NEW LASTCHAR,ORFIEN,ORFROM1,XFNM,XFNMLEN
+29 SET ORFIEN=ORFROM
+30 SET (ORFROM,ORFROM1)=$PIECE(^VA(200,ORFROM,0),U)
SET $PIECE(ORFROM,",",2)=$EXTRACT($PIECE(ORFROM,",",2),1,2)
+31 ; ** NSR 20110606/539 - Add ORFNM, ORFNMLEN and ORLNM **
SET ORFNM=$PIECE(ORFROM,",",2)
SET ORFNMLEN=$LENGTH(ORFNM)
SET ORLNM=$PIECE(ORFROM,",")
+32 IF ORFNM]""
Begin DoDot:2
+33 SET XFNM=$PIECE(ORFROM,",",2)
SET XFNMLEN=$LENGTH(XFNM)
SET LASTCHAR=$CHAR($ASCII(XFNM,XFNMLEN)-1)
SET XFNM=$EXTRACT(XFNM,1,XFNMLEN-1)_LASTCHAR_$CHAR(126)
+34 SET $PIECE(ORFROM,",",2)=XFNM
End DoDot:2
+35 SET ORI=ORI+1
SET ORY(ORI)=ORFIEN_"^"_$$NAMEFMT^XLFNAME(ORFROM1,"F","DcMPC")
+36 SET ORDUPNM(ORFIEN)=""
+37 SET ORIEN2=ORFIEN
+38 ;Using COS2 instead of COS4(0) in case duplicate (same but different) entry found later
+39 DO COS2
End DoDot:1
+40 IF '$TEST
Begin DoDot:1
+41 SET (ORFNM,ORFNMLEN,ORLNM)=""
End DoDot:1
+42 ;
ND IF +$GET(ORTIUDA)
SET ORTIUTYP=+$GET(^TIU(8925,+$GET(ORTIUDA),0))
+1 ;
+2 ;Check for quitting with ORSIM and names comparison (539)
FOR
if ORI'<ORMAX
QUIT
SET ORFROM=$ORDER(^VA(200,"AUSER",ORFROM),ORDIR)
if ORFROM=""!'$$CHKORSIM(ORSIM,ORFNM,ORFNMLEN,ORFROM,ORLNM)
QUIT
Begin DoDot:1
+3 SET ORIEN1=""
+4 FOR
SET ORIEN1=$ORDER(^VA(200,"AUSER",ORFROM,ORIEN1),ORDIR)
if 'ORIEN1
QUIT
Begin DoDot:2
+5 IF $DATA(ORDUPNM(ORIEN1))
QUIT
+6 ; Terminated?
IF '$$PROVIDER^XUSER(ORIEN1,1)
QUIT
+7 ;(USR PROVIDER CLASS CHECK?)
IF '$$ISA^USRLM(+ORIEN1,"PROVIDER",.ORERR,ORDATE)
QUIT
TIU ; User requiers cosigner
IF $$REQCOSIG^TIULP(ORTIUTYP,ORTIUDA,ORIEN1,ORDATE)
QUIT
+1 ;Check if Similar Provider call
IF ORSIM
IF ('+$$ACCESS^XQCHK(ORIEN1,OPTIEN)!'$$FIND1^DIC(200.010113,","_ORIEN1_",","","COR"))
QUIT
+2 ;I ($L(ORKEY)),(ORKEY'="COSIGNER"),('$D(^XUSEC(ORKEY,+ORIEN1))) Q ; Check for key?
+3 ;I ORDATE>0,$$GET^XUA4A72(ORIEN1,ORDATE)<1 Q ; Check date?
+4 SET ORI=ORI+1
SET ORY(ORI)=ORIEN1_"^"_$$NAMEFMT^XLFNAME(ORFROM,"F","DcMPC")
+5 ; Init flag, check dupe.
SET ORDUP=0
+6 IF ($PIECE(ORPREV_" "," ")=$PIECE(ORFROM_" "," "))
SET ORDUP=1
+7 ;
+8 ; Append Title if not duplicated:
+9 IF 'ORDUP
Begin DoDot:3
+10 SET ORIEN2=ORIEN1
+11 ; Get Title. *533 & NPI
DO COS4(0)
+12 ; add NPI data *533 ; ajb
+13 IF ORTTL=""
SET ORY(ORI)=ORY(ORI)_U_ORNPI
QUIT
+14 SET ORY(ORI)=ORY(ORI)_U_"- "_ORTTL_ORNPI
+15 IF ORTTL=""
QUIT
+16 SET ORY(ORI)=ORY(ORI)_U_"- "_ORTTL
End DoDot:3
+17 ;
+18 ; Get data in case of dupes:
+19 IF ORDUP
Begin DoDot:3
+20 ; Prev IEN for NP2 call.
SET ORIEN2=ORLAST
+21 ;
+22 ; Reset, use previous array element, call for extended data:
+23 SET ORI=ORI-1
SET ORY(ORI)=$PIECE(ORY(ORI),U)_U_$PIECE(ORY(ORI),U,2)
DO COS2
+24 ;
+25 ; Then return to current user for second extended data call:
+26 SET ORIEN2=ORIEN1
SET ORI=ORI+1
DO COS2
End DoDot:3
+27 ; Reassign vars for next pass.
SET ORLAST=ORIEN1
SET ORPREV=ORFROM
End DoDot:2
End DoDot:1
+28 ;
END QUIT
+1 ;
COS2 ; Retrieve subset of data for dupes in COSIGNER.
+1 ; (Assumes certain vars already set/new'd in calling code.)
+2 ;
+3 ; Variables used:
+4 ; ORZ = Memory array storage variable.
+5 ; ORZERR = Error storage for LIST^DIC call.
+6 ;
+7 ; Initialize variables.
NEW ORZ,ORZERR
+8 ; Reset each time.
SET ORDIV=""
+9 ; Get Title, Service/Section.
DO COS4(1)
+10 ;
+11 ; For multi-divisional site, get Division if determinable:
+12 IF ORMULTI
Begin DoDot:1
+13 DO LIST^DIC(200.02,","_ORIEN2_",","@;.01;1","QP","","","","","","","ORZ","ORZERR")
+14 ; Initialize variables.
SET (ORDD,ORGOOD)=0
+15 ; Division not listed.
IF $PIECE(ORZ("DILIST",0),U)=0
QUIT
+16 ; Only one, so use it.
IF $PIECE(ORZ("DILIST",0),U)=1
Begin DoDot:2
+17 ; Get the node's entry.
SET ORDD=$ORDER(ORZ("DILIST",ORDD))
+18 ; Get actual name value.
SET ORDIV=$PIECE(ORDD,U,2)
End DoDot:2
QUIT
+19 ;
+20 ; More than one Division entry, so:
+21 FOR
SET ORDD=$ORDER(ORZ("DILIST",ORDD))
if +ORDD=0!'($LENGTH(ORDD))
QUIT
Begin DoDot:2
+22 ;
+23 ; See if current entry being processed is "Default" (done if so):
+24 ; Division text.
IF $PIECE(ORZ("DILIST",ORDD,0),U,3)["Y"
SET ORDIV=$PIECE(ORZ("DILIST",ORDD,0),U,2)
SET ORGOOD=1
QUIT
End DoDot:2
if ORGOOD
QUIT
End DoDot:1
+25 ;
+26 ; Append new pieces to array string:
+27 SET ORMRK=""
+28 ; Nothing to append.
IF (ORTTL="")&(ORSRV="")&(ORDIV="")&(ORNPI="")
QUIT
+29 ; At least something exists.
SET ORY(ORI)=ORY(ORI)_U_"- "
+30 ; Title.
IF (ORTTL'="")
SET ORY(ORI)=ORY(ORI)_ORTTL
SET ORMRK=", "
+31 ; Service.
IF (ORSRV'="")
SET ORY(ORI)=ORY(ORI)_ORMRK_ORSRV
SET ORMRK=", "
+32 ; Division.
IF (ORDIV'="")
SET ORY(ORI)=ORY(ORI)_ORMRK_ORDIV
+33 ; NPI *533
IF (ORNPI'="")
SET ORY(ORI)=ORY(ORI)_ORNPI
+34 ;
+35 QUIT
+36 ;
+37 ;
COS4(ORSS) ; Retrieve Title or Title and Service/Section.
+1 ; (Assumes certain vars already set/new'd in calling code.)
+2 ;
+3 ; Passed variable ORSS: If true, get Service/Section also.
+4 ;
+5 ; Init each time.
SET (ORNPI,ORTTL,ORSRV)=""
+6 ; DBIA# 4329:
+7 ; Get Title pointer.
SET ORTTL=$PIECE($GET(^VA(200,ORIEN2,0)),U,9)
+8 ; Get NPI. *533 ICR#4532
SET ORNPI=+$$NPI^XUSNPI("Individual_ID",ORIEN2)
+9 SET ORNPI=$SELECT(ORNPI>0:" [NPI:"_ORNPI_"]",1:"")
+10 ; Reset var if none.
IF ORTTL<1
SET ORTTL=""
+11 ; DBIA# 1234:
+12 ; Actual Title value.
IF ORTTL>0
SET ORTTL=$$TITLE^XLFSTR($GET(^DIC(3.1,ORTTL,0)))
+13 SET ORSS=$GET(ORSS)
+14 ; Get Service/Section?
IF ORSS
Begin DoDot:1
+15 ; DBIA# 4329:
+16 ; Get S/S pointer.
SET ORSRV=$PIECE($GET(^VA(200,ORIEN2,5)),U,1)
+17 ; Reset var if none.
IF ORSRV<1
SET ORSRV=""
+18 ; DBIA# 4330:
+19 ; Actual S/S value.
IF ORSRV>0
SET ORSRV=$$TITLE^XLFSTR($PIECE($GET(^DIC(49,ORSRV,0)),U))
End DoDot:1
+20 ;
+21 QUIT
+22 ;
CHKORSIM(ORSIM,ORFNM,ORFNMLEN,ORFROM,ORLNM) ; If this is a Similiar Provider call check for matching names - 539
+1 ; If 'ORSIM, no additional restrictions
IF 'ORSIM
QUIT 1
+2 ; If last names don't match, quit now
IF $EXTRACT(ORFROM,1,$LENGTH(ORLNM))'=ORLNM
QUIT 0
+3 ; If first name portions don't match, quit now
IF $EXTRACT($PIECE(ORFROM,",",2),1,ORFNMLEN)'=ORFNM
QUIT 0
+4 ; All checks passed
QUIT 1
