RGPOC1 ;BIR/PTD-ADD/EDIT POINT OF CONTACT OPTION - CONTINUED ;8/22/01
;;1.0;CLINICAL INFO RESOURCE NETWORK;**21**;30 Apr 99
;
POC1 ;ADMIN POINT OF CONTACT from CIRN SITE PARAMETER (#991.8) file.
W ! K RGDATA S RGDATA=$$NAME^RGPOC(1,50)
S RGADMONM=$P($G(RGDATA),"^") I RGADMONM=-1 D ERROR1^RGPOC("ADM") S RGQUIT=1 Q
S RGADMNNM=$P($G(RGDATA),"^",2)
I RGADMONM'="",RGADMNNM="" S RGARRAY(10)="Admin Point of Contact Name: <DELETE EXISTING DATA>",RGARRAY(11)="" Q
I RGADMNNM="" D ERROR1^RGPOC("ADM") Q
S RGARRAY(10)="Admin Point of Contact Name: "_$$CNVRTNM^RGPOC(RGADMNNM)
K RGDATA S RGDATA=$$PHONE^RGPOC(+RGADMNNM)
S RGADMOFN=$P($G(RGDATA),"^") I RGADMOFN=-1 D ERROR2^RGPOC("ADM",50,RGADMONM,RGADMNNM) K RGARRAY(10) S RGQUIT=1 Q
S RGADMNFN=$P($G(RGDATA),"^",2)
I RGADMNFN="" D ERROR2^RGPOC("ADM",50,RGADMONM,RGADMNNM) K RGARRAY(10) Q
I ($TR(RGADMNFN," ","")=$TR(RGADMOFN," ",""))&(RGADMNNM=RGADMONM) K RGARRAY(10) Q
S RGARRAY(11)="Admin Point of Contact Phone #: "_RGADMNFN
S RGARRAY(12)=""
Q
;
POC2 ;ALTERNATE ADMIN POINT OF CONTACT from CIRN SITE PARAMETER (#991.8) file.
W ! K RGDATA S RGDATA=$$NAME^RGPOC(4,53)
S RGAD2ONM=$P($G(RGDATA),"^") I RGAD2ONM=-1 D ERROR1^RGPOC("ALT ADM") S RGQUIT=1 Q
S RGAD2NNM=$P($G(RGDATA),"^",2)
I RGAD2ONM'="",RGAD2NNM="" S RGARRAY(20)="Alt Admin Point of Contact Name: <DELETE EXISTING DATA>",RGARRAY(21)="" Q
I RGAD2NNM="" D ERROR1^RGPOC("ALT ADM") Q
S RGARRAY(20)="Alt Admin Point of Contact Name: "_$$CNVRTNM^RGPOC(RGAD2NNM)
K RGDATA S RGDATA=$$PHONE^RGPOC(+RGAD2NNM)
S RGAD2OFN=$P($G(RGDATA),"^") I RGAD2OFN=-1 D ERROR2^RGPOC("ADM",53,RGAD2ONM,RGAD2NNM) K RGARRAY(20) S RGQUIT=1 Q
S RGAD2NFN=$P($G(RGDATA),"^",2)
I RGAD2NFN="" D ERROR2^RGPOC("ADM",53,RGAD2ONM,RGAD2NNM) K RGARRAY(20) Q
I ($TR(RGAD2NFN," ","")=$TR(RGAD2OFN," ",""))&(RGAD2NNM=RGAD2ONM) K RGARRAY(20) Q
S RGARRAY(21)="Alt Admin Point of Contact Phone #: "_RGAD2NFN
S RGARRAY(22)=""
Q
;
POC3 ;IRM POINT OF CONTACT from CIRN SITE PARAMETER (#991.8) file.
W ! K RGDATA S RGDATA=$$NAME^RGPOC(2,51)
S RGIRMONM=$P($G(RGDATA),"^") I RGIRMONM=-1 D ERROR1^RGPOC("IRM") S RGQUIT=1 Q
S RGIRMNNM=$P($G(RGDATA),"^",2)
I RGIRMONM'="",RGIRMNNM="" S RGARRAY(30)="IRM Point of Contact Name: <DELETE EXISTING DATA>",RGARRAY(31)="" Q
I RGIRMNNM="" D ERROR1^RGPOC("IRM") Q
S RGARRAY(30)="IRM Point of Contact Name: "_$$CNVRTNM^RGPOC(RGIRMNNM)
K RGDATA S RGDATA=$$PHONE^RGPOC(+RGIRMNNM)
S RGIRMOFN=$P($G(RGDATA),"^") I RGIRMOFN=-1 D ERROR2^RGPOC("IRM",51,RGIRMONM,RGIRMNNM) K RGARRAY(30) S RGQUIT=1 Q
S RGIRMNFN=$P($G(RGDATA),"^",2)
I RGIRMNFN="" D ERROR2^RGPOC("IRM",51,RGIRMONM,RGIRMNNM) K RGARRAY(30) Q
I ($TR(RGIRMNFN," ","")=$TR(RGIRMOFN," ",""))&(RGIRMNNM=RGIRMONM) K RGARRAY(30) Q
S RGARRAY(31)="IRM Point of Contact Phone #: "_RGIRMNFN
S RGARRAY(32)=""
Q
;
POC4 ;ALTERNATE IRM POINT OF CONTACT from CIRN SITE PARAMETER (#991.8) file.
W ! K RGDATA S RGDATA=$$NAME^RGPOC(5,54)
S RGIR2ONM=$P($G(RGDATA),"^") I RGIR2ONM=-1 D ERROR1^RGPOC("ALT IRM") S RGQUIT=1 Q
S RGIR2NNM=$P($G(RGDATA),"^",2)
I RGIR2ONM'="",RGIR2NNM="" S RGARRAY(40)="Alt IRM Point of Contact Name: <DELETE EXISTING DATA>",RGARRAY(41)="" Q
I RGIR2NNM="" D ERROR1^RGPOC("ALT IRM") Q
S RGARRAY(40)="Alt IRM Point of Contact Name: "_$$CNVRTNM^RGPOC(RGIR2NNM)
K RGDATA S RGDATA=$$PHONE^RGPOC(+RGIR2NNM)
S RGIR2OFN=$P($G(RGDATA),"^") I RGIR2OFN=-1 D ERROR2^RGPOC("ALT IRM",54,RGIR2ONM,RGIR2NNM) K RGARRAY(40) S RGQUIT=1 Q
S RGIR2NFN=$P($G(RGDATA),"^",2)
I RGIR2NFN="" D ERROR2^RGPOC("ALT IRM",54,RGIR2ONM,RGIR2NNM) K RGARRAY(40) Q
I ($TR(RGIR2NFN," ","")=$TR(RGIR2OFN," ",""))&(RGIR2NNM=RGIR2ONM) K RGARRAY(40) Q
S RGARRAY(41)="Alt IRM Point of Contact Phone #: "_RGIR2NFN
S RGARRAY(42)=""
Q
;
POC5 ;HL7 POINT OF CONTACT from CIRN SITE PARAMETER (#991.8) file.
W ! K RGDATA S RGDATA=$$NAME^RGPOC(3,52)
S RGHL7ONM=$P($G(RGDATA),"^") I RGHL7ONM=-1 D ERROR1^RGPOC("HL7") S RGQUIT=1 Q
S RGHL7NNM=$P($G(RGDATA),"^",2)
I RGHL7ONM'="",RGHL7NNM="" S RGARRAY(50)="HL7 Point of Contact Name: <DELETE EXISTING DATA>",RGARRAY(51)="" Q
I RGHL7NNM="" D ERROR1^RGPOC("HL7") Q
S RGARRAY(50)="HL7 Point of Contact Name: "_$$CNVRTNM^RGPOC(RGHL7NNM)
K RGDATA S RGDATA=$$PHONE^RGPOC(+RGHL7NNM)
S RGHL7OFN=$P($G(RGDATA),"^") I RGHL7OFN=-1 D ERROR2^RGPOC("HL7",52,RGHL7ONM,RGHL7NNM) K RGARRAY(50) S RGQUIT=1 Q
S RGHL7NFN=$P($G(RGDATA),"^",2)
I RGHL7NFN="" D ERROR2^RGPOC("HL7",52,RGHL7ONM,RGHL7NNM) K RGARRAY(50) Q
I ($TR(RGHL7NFN," ","")=$TR(RGHL7OFN," ",""))&(RGHL7NNM=RGHL7ONM) K RGARRAY(50) Q
S RGARRAY(51)="HL7 Point of Contact Phone #: "_RGHL7NFN
S RGARRAY(52)=""
Q
;
POC6 ;ALTERNATE HL7 POINT OF CONTACT from CIRN SITE PARAMETER (#991.8) file.
W ! K RGDATA S RGDATA=$$NAME^RGPOC(6,55)
S RGHL2ONM=$P($G(RGDATA),"^") I RGHL2ONM=-1 D ERROR1^RGPOC("ALT HL7") S RGQUIT=1 Q
S RGHL2NNM=$P($G(RGDATA),"^",2)
I RGHL2ONM'="",RGHL2NNM="" S RGARRAY(60)="Alt HL7 Point of Contact Name: <DELETE EXISTING DATA>",RGARRAY(61)="" Q
I RGHL2NNM="" D ERROR1^RGPOC("ALT HL7") Q
S RGARRAY(60)="Alt HL7 Point of Contact Name: "_$$CNVRTNM^RGPOC(RGHL2NNM)
K RGDATA S RGDATA=$$PHONE^RGPOC(+RGHL2NNM)
S RGHL2OFN=$P($G(RGDATA),"^") I RGHL2OFN=-1 D ERROR2^RGPOC("ALT HL7",55,RGHL2ONM,RGHL2NNM) K RGARRAY(60) S RGQUIT=1 Q
S RGHL2NFN=$P($G(RGDATA),"^",2)
I RGHL2NFN="" D ERROR2^RGPOC("ALT HL7",55,RGHL2ONM,RGHL2NNM) K RGARRAY(60) Q
I ($TR(RGHL2NFN," ","")=$TR(RGHL2OFN," ",""))&(RGHL2NNM=RGHL2ONM) K RGARRAY(60) Q
S RGARRAY(61)="Alt HL7 Point of Contact Phone #: "_RGHL2NFN
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGPOC1 5568 printed Sep 23, 2025@19:18:41 Page 2
RGPOC1 ;BIR/PTD-ADD/EDIT POINT OF CONTACT OPTION - CONTINUED ;8/22/01
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**21**;30 Apr 99
+2 ;
POC1 ;ADMIN POINT OF CONTACT from CIRN SITE PARAMETER (#991.8) file.
+1 WRITE !
KILL RGDATA
SET RGDATA=$$NAME^RGPOC(1,50)
+2 SET RGADMONM=$PIECE($GET(RGDATA),"^")
IF RGADMONM=-1
DO ERROR1^RGPOC("ADM")
SET RGQUIT=1
QUIT
+3 SET RGADMNNM=$PIECE($GET(RGDATA),"^",2)
+4 IF RGADMONM'=""
IF RGADMNNM=""
SET RGARRAY(10)="Admin Point of Contact Name: <DELETE EXISTING DATA>"
SET RGARRAY(11)=""
QUIT
+5 IF RGADMNNM=""
DO ERROR1^RGPOC("ADM")
QUIT
+6 SET RGARRAY(10)="Admin Point of Contact Name: "_$$CNVRTNM^RGPOC(RGADMNNM)
+7 KILL RGDATA
SET RGDATA=$$PHONE^RGPOC(+RGADMNNM)
+8 SET RGADMOFN=$PIECE($GET(RGDATA),"^")
IF RGADMOFN=-1
DO ERROR2^RGPOC("ADM",50,RGADMONM,RGADMNNM)
KILL RGARRAY(10)
SET RGQUIT=1
QUIT
+9 SET RGADMNFN=$PIECE($GET(RGDATA),"^",2)
+10 IF RGADMNFN=""
DO ERROR2^RGPOC("ADM",50,RGADMONM,RGADMNNM)
KILL RGARRAY(10)
QUIT
+11 IF ($TRANSLATE(RGADMNFN," ","")=$TRANSLATE(RGADMOFN," ",""))&(RGADMNNM=RGADMONM)
KILL RGARRAY(10)
QUIT
+12 SET RGARRAY(11)="Admin Point of Contact Phone #: "_RGADMNFN
+13 SET RGARRAY(12)=""
+14 QUIT
+15 ;
POC2 ;ALTERNATE ADMIN POINT OF CONTACT from CIRN SITE PARAMETER (#991.8) file.
+1 WRITE !
KILL RGDATA
SET RGDATA=$$NAME^RGPOC(4,53)
+2 SET RGAD2ONM=$PIECE($GET(RGDATA),"^")
IF RGAD2ONM=-1
DO ERROR1^RGPOC("ALT ADM")
SET RGQUIT=1
QUIT
+3 SET RGAD2NNM=$PIECE($GET(RGDATA),"^",2)
+4 IF RGAD2ONM'=""
IF RGAD2NNM=""
SET RGARRAY(20)="Alt Admin Point of Contact Name: <DELETE EXISTING DATA>"
SET RGARRAY(21)=""
QUIT
+5 IF RGAD2NNM=""
DO ERROR1^RGPOC("ALT ADM")
QUIT
+6 SET RGARRAY(20)="Alt Admin Point of Contact Name: "_$$CNVRTNM^RGPOC(RGAD2NNM)
+7 KILL RGDATA
SET RGDATA=$$PHONE^RGPOC(+RGAD2NNM)
+8 SET RGAD2OFN=$PIECE($GET(RGDATA),"^")
IF RGAD2OFN=-1
DO ERROR2^RGPOC("ADM",53,RGAD2ONM,RGAD2NNM)
KILL RGARRAY(20)
SET RGQUIT=1
QUIT
+9 SET RGAD2NFN=$PIECE($GET(RGDATA),"^",2)
+10 IF RGAD2NFN=""
DO ERROR2^RGPOC("ADM",53,RGAD2ONM,RGAD2NNM)
KILL RGARRAY(20)
QUIT
+11 IF ($TRANSLATE(RGAD2NFN," ","")=$TRANSLATE(RGAD2OFN," ",""))&(RGAD2NNM=RGAD2ONM)
KILL RGARRAY(20)
QUIT
+12 SET RGARRAY(21)="Alt Admin Point of Contact Phone #: "_RGAD2NFN
+13 SET RGARRAY(22)=""
+14 QUIT
+15 ;
POC3 ;IRM POINT OF CONTACT from CIRN SITE PARAMETER (#991.8) file.
+1 WRITE !
KILL RGDATA
SET RGDATA=$$NAME^RGPOC(2,51)
+2 SET RGIRMONM=$PIECE($GET(RGDATA),"^")
IF RGIRMONM=-1
DO ERROR1^RGPOC("IRM")
SET RGQUIT=1
QUIT
+3 SET RGIRMNNM=$PIECE($GET(RGDATA),"^",2)
+4 IF RGIRMONM'=""
IF RGIRMNNM=""
SET RGARRAY(30)="IRM Point of Contact Name: <DELETE EXISTING DATA>"
SET RGARRAY(31)=""
QUIT
+5 IF RGIRMNNM=""
DO ERROR1^RGPOC("IRM")
QUIT
+6 SET RGARRAY(30)="IRM Point of Contact Name: "_$$CNVRTNM^RGPOC(RGIRMNNM)
+7 KILL RGDATA
SET RGDATA=$$PHONE^RGPOC(+RGIRMNNM)
+8 SET RGIRMOFN=$PIECE($GET(RGDATA),"^")
IF RGIRMOFN=-1
DO ERROR2^RGPOC("IRM",51,RGIRMONM,RGIRMNNM)
KILL RGARRAY(30)
SET RGQUIT=1
QUIT
+9 SET RGIRMNFN=$PIECE($GET(RGDATA),"^",2)
+10 IF RGIRMNFN=""
DO ERROR2^RGPOC("IRM",51,RGIRMONM,RGIRMNNM)
KILL RGARRAY(30)
QUIT
+11 IF ($TRANSLATE(RGIRMNFN," ","")=$TRANSLATE(RGIRMOFN," ",""))&(RGIRMNNM=RGIRMONM)
KILL RGARRAY(30)
QUIT
+12 SET RGARRAY(31)="IRM Point of Contact Phone #: "_RGIRMNFN
+13 SET RGARRAY(32)=""
+14 QUIT
+15 ;
POC4 ;ALTERNATE IRM POINT OF CONTACT from CIRN SITE PARAMETER (#991.8) file.
+1 WRITE !
KILL RGDATA
SET RGDATA=$$NAME^RGPOC(5,54)
+2 SET RGIR2ONM=$PIECE($GET(RGDATA),"^")
IF RGIR2ONM=-1
DO ERROR1^RGPOC("ALT IRM")
SET RGQUIT=1
QUIT
+3 SET RGIR2NNM=$PIECE($GET(RGDATA),"^",2)
+4 IF RGIR2ONM'=""
IF RGIR2NNM=""
SET RGARRAY(40)="Alt IRM Point of Contact Name: <DELETE EXISTING DATA>"
SET RGARRAY(41)=""
QUIT
+5 IF RGIR2NNM=""
DO ERROR1^RGPOC("ALT IRM")
QUIT
+6 SET RGARRAY(40)="Alt IRM Point of Contact Name: "_$$CNVRTNM^RGPOC(RGIR2NNM)
+7 KILL RGDATA
SET RGDATA=$$PHONE^RGPOC(+RGIR2NNM)
+8 SET RGIR2OFN=$PIECE($GET(RGDATA),"^")
IF RGIR2OFN=-1
DO ERROR2^RGPOC("ALT IRM",54,RGIR2ONM,RGIR2NNM)
KILL RGARRAY(40)
SET RGQUIT=1
QUIT
+9 SET RGIR2NFN=$PIECE($GET(RGDATA),"^",2)
+10 IF RGIR2NFN=""
DO ERROR2^RGPOC("ALT IRM",54,RGIR2ONM,RGIR2NNM)
KILL RGARRAY(40)
QUIT
+11 IF ($TRANSLATE(RGIR2NFN," ","")=$TRANSLATE(RGIR2OFN," ",""))&(RGIR2NNM=RGIR2ONM)
KILL RGARRAY(40)
QUIT
+12 SET RGARRAY(41)="Alt IRM Point of Contact Phone #: "_RGIR2NFN
+13 SET RGARRAY(42)=""
+14 QUIT
+15 ;
POC5 ;HL7 POINT OF CONTACT from CIRN SITE PARAMETER (#991.8) file.
+1 WRITE !
KILL RGDATA
SET RGDATA=$$NAME^RGPOC(3,52)
+2 SET RGHL7ONM=$PIECE($GET(RGDATA),"^")
IF RGHL7ONM=-1
DO ERROR1^RGPOC("HL7")
SET RGQUIT=1
QUIT
+3 SET RGHL7NNM=$PIECE($GET(RGDATA),"^",2)
+4 IF RGHL7ONM'=""
IF RGHL7NNM=""
SET RGARRAY(50)="HL7 Point of Contact Name: <DELETE EXISTING DATA>"
SET RGARRAY(51)=""
QUIT
+5 IF RGHL7NNM=""
DO ERROR1^RGPOC("HL7")
QUIT
+6 SET RGARRAY(50)="HL7 Point of Contact Name: "_$$CNVRTNM^RGPOC(RGHL7NNM)
+7 KILL RGDATA
SET RGDATA=$$PHONE^RGPOC(+RGHL7NNM)
+8 SET RGHL7OFN=$PIECE($GET(RGDATA),"^")
IF RGHL7OFN=-1
DO ERROR2^RGPOC("HL7",52,RGHL7ONM,RGHL7NNM)
KILL RGARRAY(50)
SET RGQUIT=1
QUIT
+9 SET RGHL7NFN=$PIECE($GET(RGDATA),"^",2)
+10 IF RGHL7NFN=""
DO ERROR2^RGPOC("HL7",52,RGHL7ONM,RGHL7NNM)
KILL RGARRAY(50)
QUIT
+11 IF ($TRANSLATE(RGHL7NFN," ","")=$TRANSLATE(RGHL7OFN," ",""))&(RGHL7NNM=RGHL7ONM)
KILL RGARRAY(50)
QUIT
+12 SET RGARRAY(51)="HL7 Point of Contact Phone #: "_RGHL7NFN
+13 SET RGARRAY(52)=""
+14 QUIT
+15 ;
POC6 ;ALTERNATE HL7 POINT OF CONTACT from CIRN SITE PARAMETER (#991.8) file.
+1 WRITE !
KILL RGDATA
SET RGDATA=$$NAME^RGPOC(6,55)
+2 SET RGHL2ONM=$PIECE($GET(RGDATA),"^")
IF RGHL2ONM=-1
DO ERROR1^RGPOC("ALT HL7")
SET RGQUIT=1
QUIT
+3 SET RGHL2NNM=$PIECE($GET(RGDATA),"^",2)
+4 IF RGHL2ONM'=""
IF RGHL2NNM=""
SET RGARRAY(60)="Alt HL7 Point of Contact Name: <DELETE EXISTING DATA>"
SET RGARRAY(61)=""
QUIT
+5 IF RGHL2NNM=""
DO ERROR1^RGPOC("ALT HL7")
QUIT
+6 SET RGARRAY(60)="Alt HL7 Point of Contact Name: "_$$CNVRTNM^RGPOC(RGHL2NNM)
+7 KILL RGDATA
SET RGDATA=$$PHONE^RGPOC(+RGHL2NNM)
+8 SET RGHL2OFN=$PIECE($GET(RGDATA),"^")
IF RGHL2OFN=-1
DO ERROR2^RGPOC("ALT HL7",55,RGHL2ONM,RGHL2NNM)
KILL RGARRAY(60)
SET RGQUIT=1
QUIT
+9 SET RGHL2NFN=$PIECE($GET(RGDATA),"^",2)
+10 IF RGHL2NFN=""
DO ERROR2^RGPOC("ALT HL7",55,RGHL2ONM,RGHL2NNM)
KILL RGARRAY(60)
QUIT
+11 IF ($TRANSLATE(RGHL2NFN," ","")=$TRANSLATE(RGHL2OFN," ",""))&(RGHL2NNM=RGHL2ONM)
KILL RGARRAY(60)
QUIT
+12 SET RGARRAY(61)="Alt HL7 Point of Contact Phone #: "_RGHL2NFN
+13 QUIT
+14 ;
