- 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 Dec 13, 2024@01:42:42 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 ;