VENPCCM3 ; IHS/OIT/GIS - PRINT GROUP SYNCHRONIZATION - ;
;;2.6;PCC+;;NOV 12, 2007
;
;
;
PG(NAME) ; EP-VALIDATE AND SYNCHRONIZE INDIVIDUAL PRINT GROUPS
I '$L($G(NAME)) Q
NEW N IP,IPA,SOCK,PSTG,FSTG,X,Y,Z,%,STOP,PG1,PG2,RPMS,DA,DR,DIC,DIE,MR
N PSN,STOP,PS1,PS2,RPMS,I,X,Y,PCE,PIEN,OK,BAD,WARN,STG
VAR I '$$VAR^VENPCCM1 Q
RPMS ; RPMS PRINT GROUPS
S PIEN=0,RPMS=""
F S PIEN=$O(^VEN(7.4,PIEN)) Q:'PIEN S X=$P($G(^VEN(7.4,PIEN,0)),U) D I RPMS'="" S RPMS=RPMS_U
. S RPMS=RPMS_U
. S RPMS=RPMS_X
. Q
S MR=$$MR ; LOCATE MEDICAL RECORDS PRINT GROUP
PG1 S PG1=$$PGRP^VENPCCM2(IP)
I PG1="" W !,"There are no Print Groups entered on Print Server #1",!,"You must enter Print Groups on both print servers" Q
PG2 I IP'=IPA S STOP=0 D I STOP Q
. S PG2=$$PGRP^VENPCCM2(IPA)
. I PG1="" W !,"There are no Print Groups entered on Print Server #2",!,"You must enter Print Groups on both print servers" S STOP=1 Q
. I PG2'=PG1 W !,"Print Groups entered on Print Server #2 don't match those on Print Server #1",!,"You must enter identical sets of Print Groups on both Print Servers" S STOP=1 Q
. Q
S PG1=U_PG1_U
OK I PG1[(U_NAME_"|"),RPMS[(U_NAME_U) W !,"'",NAME,"' has been successfully entered on the RPMS Server and Print Server",$S(IP'=IPA:"s",1:"") Q
MISS I PG1'[(U_NAME_"|"),RPMS'[(U_NAME_U) W !,"'",NAME,"' has not been entered on the Print Server yet",!,"You must enter this Print Group before going on" Q
BAD I RPMS[(U_NAME_U) D Q
. S DA=$O(^VEN(7.4,"B",NAME,0)) I 'DA W !,"Unable to delete ",NAME
. S DIK="^VEN(7.4," D ^DIK
. W !,NAME," has been deleted from the RPMS Server!!"
. Q
ADD W !,"'",NAME,"' has not been regestered on the RPMS server yet!"
W !,"Do you want to do this now"
S %=1 D YN^DICN I %'=1 Q
S DLAYGO=19707.4,X=NAME,DIC="^VEN(7.4,",DIC(0)="L" D ^DIC S DA=+Y
I Y=-1 Q
W !,NAME," entered on the RPMS Server!!"
I MR Q
I DA W !,"Is this Print Group located in the Medical Records Department" S %=2 D YN^DICN I %'=1 Q
ADDMR ; DEFINE THE MED REC PRINT GRP
S DIE="^VEN(7.4,",DR=".02////1" L +^VEN(7.4):0 I $T D ^DIE L -^VEN(7.4) W !,NAME," has been designated as the Medical Records Print Group"
Q
;
ONE ; EP-CHECK ONE PRINT GROUP
S DIR(0)="FO^1:30",DIR("A")="Enter the name of the Print Group" KILL DA D ^DIR KILL DIR
I '$L(Y) Q
W !,"One moment please..."
D PG(Y)
D ^XBFMK
Q
;
ALL ; EP-CHECK ALL PRINT GROUPS ON PRINT SERVER #1
N IP,STG,PGN,NAME
I $D(IP1) S IP=IP1
E S IP=$P($G(^VEN(7.5,$$CFG^VENPCCU,11)),U) I '$L(IP) W !,"Unable to find an IP address for Print Server #1" Q
W !,"Checking all templates on Print Server #1......."
W !,"One moment please..."
S STG=$$PGRP^VENPCCM2(IP) I $L(STG)'>1 W "Unable to locate any Print Groups on Print Server #1" Q
F PGN=1:1:$L(STG,U) S NAME=$P(STG,U,PGN) S NAME=$P(NAME,"|") W !,"Checking ",NAME D PG(NAME)
D ^XBFMK
Q
;
MR() ; MED REC PRINT GROUP
N MR,X,%
S (MR,X)=0 F S X=$O(^VEN(7.4,X)) Q:'X S %=^(X,0) I $P(%,U,2) S MR=X Q
Q MR
;
; --------------------------------------------
;
QCK ; EP-CHECK QUEUE TYPE FILE
W !!,"Checking the QUEUE TYPE file..."
N Q,N,DUP,D,DNO,DIK,DIC,X,Y,C,MISS,NAME,QIEN,CIEN
S (DIK,DIC)="^VEN(7.22,"
DUP S Q="",DUP="" ; DUP QUEUE TYPES
F S Q=$O(^VEN(7.22,"B",Q)) Q:Q="" S N=$O(^VEN(7.22,"B",Q,0)) S D=$O(^(N)) I D S:$L(DUP) DUP=DUP_U S DUP=DUP_D
I '$L(DUP) G MIS
W !,"The file VEN EHP QUE TYPE has duplicate records that may cause problems",!,"Want to delete the duplicates"
S %=1 D YN^DICN I %'=1 G MIS
F DNO=1:1:$L(DUP) S DA=$P(DUP,U,DNO) D ^DIK
W !,"Duplicates removed!!" K DUP
MIS ; MISSING QUEUE TYPES
S C="",MISS=""
F S C=$O(^VEN(7.95,"B",C)) Q:C="" I '$D(^VEN(7.22,"B",C)) S:$L(MISS) MISS=MISS_U S MISS=MISS_C
I '$L(MISS) G FIN
W !,"The following clinics are not found in the QUEUE TYPE file =>"
F %=1:1:$L(MISS,U) W !?5,$P(MISS,U,%)
S %=1 W !!,"Want to add these to the QUEUE TYPE file"
D YN^DICN I %'=1 G FIN
S DIC(0)="L",DLAYGO=19707.22,DIC="^VEN(7.22,"
F CNO=1:1:$L(MISS,U) S X=$P(MISS,U,CNO) I $L(X) D ^DIC I $P(Y,U,3) W !?5,$P(Y,U,2)," added to the QUEUE TYPE file"
K MISS
FIN S NAME="" F S NAME=$O(^VEN(7.22,"B",NAME)) Q:NAME="" S QIEN=$O(^VEN(7.22,"B",NAME,0)),CIEN=$O(^VEN(7.95,"B",NAME,0)) I QIEN,CIEN S $P(^VEN(7.95,CIEN,1),U)=QIEN
I '$L($G(DUP)),'$L($G(MISS)) W !,"The QUEUE TYPE file has been validated!!" H 2
D ^XBFMK
Q
;
; ---------------------------------------------------
;
CADD ; EP-ADD A NEW CLINIC
N X,Y,%,DIEN,DIC,DIE,DR,DA,DLAYGO,POP,NAME
W !!?20,"***** ADD / EDIT A PCC+ CLINIC *****"
W !!,"To add a new clinic, answer the following questions"
W !,"At any time, you may enter '??' to see the choices",!!
W !,"Enter the name of the new clinic. It should be in the format:",!!?3,"{SITE} - {CLINIC} e.g., ANMC - PEDIATRICS or CROW - DENTAL",!
C1 S DIC="^VEN(7.95,",DIC(0)="AEQL",DIC("A")="Clinic name: ",DLAYGO=19707.95
D ^DIC I Y=-1 G CFIN
S DIE=DIC,(DA,DIEN)=+Y,NAME=$P(Y,U,2)
W !!,"Enter the name of the DEPARTMENT (CLINIC STOP) associated with this clinic"
S DR="2.04////^S X=DUZ(2);.04" L +^VEN(7.95):0 I $T D ^DIE L -^VEN(7.95)
W !!,"Enter the name of this clinic's DEFAULT ENCOUNTER FORM used during check-in"
S DR="2.05" L +^VEN(7.95):0 I $T D ^DIE L -^VEN(7.95)
W !!,"Enter the name of this clinic's DEFAULT HEALTH SUMMARY used during check-in"
S DR="2.06" L +^VEN(7.95):0 I $T D ^DIE L -^VEN(7.95)
W !!,"Enter the name of this clinic's DEFAULT PROVIDER used during check-in"
S DR="2.02" L +^VEN(7.95):0 I $T D ^DIE L -^VEN(7.95)
W !!,"Enter the name of this clinic's HEALTH SUMMARY PRINT GROUP"
S DR="2.09" L +^VEN(7.95):0 I $T D ^DIE L -^VEN(7.95)
W !!,"Enter the name of this clinic's ENCOUNTER FORM PRINT GROUP"
S DR="2.01" L +^VEN(7.95):0 I $T D ^DIE L -^VEN(7.95)
W !!,"Does this clinic ever require an outguide request during check-in"
S %=1 D YN^DICN I %=1 G DQ
S DR="2.1////1" L +^VEN(7.95):0 I $T D ^DIE L -^VEN(7.95)
DQ ; DESTINATION QUEUE TYPE
S Y=$O(^VEN(7.22,"B",NAME,0)) I Y G DQ1
S DIC="^VEN(7.22,",DLAYGO=19707.22,DIC(0)="L",X=""""_NAME_""""
D ^DIC I Y=-1 G CFIN
DQ1 S DIE="^VEN(7.95,",DA=DIEN,DR="1.01////"_+Y
L +^VEN(7.95):0 I $T D ^DIE L -^VEN(7.95)
W !!,"Enter the name of another clinic" G C1
CFIN D ^XBFMK
Q
;
CDEL ; EP-DELETE A CLINIC
N X,Y,%,%Y,DIC,DIK,DA
W !!
S DIC("A")="Enter the name of the clinic you want to delete: "
S DIC="^VEN(7.95,",DIC(0)="AEQL",DLAYGO=19707.95
D ^DIC I Y=-1 G CDFIN
S DA=+Y,NAME=$P(Y,U,2)
W !,"Are you sure you want to delete ",$P(Y,U,2)
S %=1 D YN^DICN I %'=1 G CDFIN
S DIK=DIC
D ^DIK W !,"Clinic deleted!!"
S DA=$O(^VEN(7.22,"B",NAME,0))
I DA S DIK="^VEN(7.22," D ^DIK W !,"The QUEUE TYPE '",NAME,"' has also been deleted"
CDFIN D ^XBFMK
Q
;
UNI ; EP-CHK VALIDITY OF UNIQUE CLINIC STATUS
N UNI,%,CFG
S CFG=$$CFG^VENPCCU
S UNI=$P($G(^VEN(7.5,CFG,0)),U,6) I 'UNI Q
I '$D(^VEN(7.95,UNI)) D Q
. S $P(^VEN(7.5,CFG,0),U,6)=""
. W !,"Invalid unique clinic! Configuration file has been automatically repaired."
. Q
S %=$O(^VEN(7.95,0)) I '$O(^VEN(7.95,%)) Q ; VALID UNIQUE FILE
W !,"The there is more than one PCC+ clinic registered!!",!,"Do you want to delete the unique clinic in the configuration file"
S %=1 D YN^DICN
I %=1 S $P(^VEN(7.5,CFG,0),U,6)=""
Q
;
VENPCCM3 ; IHS/OIT/GIS - PRINT GROUP SYNCHRONIZATION - ;
+1 ;;2.6;PCC+;;NOV 12, 2007
+2 ;
+3 ;
+4 ;
PG(NAME) ; EP-VALIDATE AND SYNCHRONIZE INDIVIDUAL PRINT GROUPS
+1 IF '$LENGTH($GET(NAME))
QUIT
NEW NEW IP,IPA,SOCK,PSTG,FSTG,X,Y,Z,%,STOP,PG1,PG2,RPMS,DA,DR,DIC,DIE,MR
+1 NEW PSN,STOP,PS1,PS2,RPMS,I,X,Y,PCE,PIEN,OK,BAD,WARN,STG
VAR IF '$$VAR^VENPCCM1
QUIT
RPMS ; RPMS PRINT GROUPS
+1 SET PIEN=0
SET RPMS=""
+2 FOR
SET PIEN=$ORDER(^VEN(7.4,PIEN))
IF 'PIEN
QUIT
SET X=$PIECE($GET(^VEN(7.4,PIEN,0)),U)
Begin DoDot:1
+3 SET RPMS=RPMS_U
+4 SET RPMS=RPMS_X
+5 QUIT
End DoDot:1
IF RPMS'=""
SET RPMS=RPMS_U
+6 ; LOCATE MEDICAL RECORDS PRINT GROUP
SET MR=$$MR
PG1 SET PG1=$$PGRP^VENPCCM2(IP)
+1 IF PG1=""
WRITE !,"There are no Print Groups entered on Print Server #1",!,"You must enter Print Groups on both print servers"
QUIT
PG2 IF IP'=IPA
SET STOP=0
Begin DoDot:1
+1 SET PG2=$$PGRP^VENPCCM2(IPA)
+2 IF PG1=""
WRITE !,"There are no Print Groups entered on Print Server #2",!,"You must enter Print Groups on both print servers"
SET STOP=1
QUIT
+3 IF PG2'=PG1
WRITE !,"Print Groups entered on Print Server #2 don't match those on Print Server #1",!,"You must enter identical sets of Print Groups on both Print Servers"
SET STOP=1
QUIT
+4 QUIT
End DoDot:1
IF STOP
QUIT
+5 SET PG1=U_PG1_U
OK IF PG1[(U_NAME_"|")
IF RPMS[(U_NAME_U)
WRITE !,"'",NAME,"' has been successfully entered on the RPMS Server and Print Server",$SELECT(IP'=IPA:"s",1:"")
QUIT
MISS IF PG1'[(U_NAME_"|")
IF RPMS'[(U_NAME_U)
WRITE !,"'",NAME,"' has not been entered on the Print Server yet",!,"You must enter this Print Group before going on"
QUIT
BAD IF RPMS[(U_NAME_U)
Begin DoDot:1
+1 SET DA=$ORDER(^VEN(7.4,"B",NAME,0))
IF 'DA
WRITE !,"Unable to delete ",NAME
+2 SET DIK="^VEN(7.4,"
DO ^DIK
+3 WRITE !,NAME," has been deleted from the RPMS Server!!"
+4 QUIT
End DoDot:1
QUIT
ADD WRITE !,"'",NAME,"' has not been regestered on the RPMS server yet!"
+1 WRITE !,"Do you want to do this now"
+2 SET %=1
DO YN^DICN
IF %'=1
QUIT
+3 SET DLAYGO=19707.4
SET X=NAME
SET DIC="^VEN(7.4,"
SET DIC(0)="L"
DO ^DIC
SET DA=+Y
+4 IF Y=-1
QUIT
+5 WRITE !,NAME," entered on the RPMS Server!!"
+6 IF MR
QUIT
+7 IF DA
WRITE !,"Is this Print Group located in the Medical Records Department"
SET %=2
DO YN^DICN
IF %'=1
QUIT
ADDMR ; DEFINE THE MED REC PRINT GRP
+1 SET DIE="^VEN(7.4,"
SET DR=".02////1"
LOCK +^VEN(7.4):0
IF $TEST
DO ^DIE
LOCK -^VEN(7.4)
WRITE !,NAME," has been designated as the Medical Records Print Group"
+2 QUIT
+3 ;
ONE ; EP-CHECK ONE PRINT GROUP
+1 SET DIR(0)="FO^1:30"
SET DIR("A")="Enter the name of the Print Group"
KILL DA
DO ^DIR
KILL DIR
+2 IF '$LENGTH(Y)
QUIT
+3 WRITE !,"One moment please..."
+4 DO PG(Y)
+5 DO ^XBFMK
+6 QUIT
+7 ;
ALL ; EP-CHECK ALL PRINT GROUPS ON PRINT SERVER #1
+1 NEW IP,STG,PGN,NAME
+2 IF $DATA(IP1)
SET IP=IP1
+3 IF '$TEST
SET IP=$PIECE($GET(^VEN(7.5,$$CFG^VENPCCU,11)),U)
IF '$LENGTH(IP)
WRITE !,"Unable to find an IP address for Print Server #1"
QUIT
+4 WRITE !,"Checking all templates on Print Server #1......."
+5 WRITE !,"One moment please..."
+6 SET STG=$$PGRP^VENPCCM2(IP)
IF $LENGTH(STG)'>1
WRITE "Unable to locate any Print Groups on Print Server #1"
QUIT
+7 FOR PGN=1:1:$LENGTH(STG,U)
SET NAME=$PIECE(STG,U,PGN)
SET NAME=$PIECE(NAME,"|")
WRITE !,"Checking ",NAME
DO PG(NAME)
+8 DO ^XBFMK
+9 QUIT
+10 ;
MR() ; MED REC PRINT GROUP
+1 NEW MR,X,%
+2 SET (MR,X)=0
FOR
SET X=$ORDER(^VEN(7.4,X))
IF 'X
QUIT
SET %=^(X,0)
IF $PIECE(%,U,2)
SET MR=X
QUIT
+3 QUIT MR
+4 ;
+5 ; --------------------------------------------
+6 ;
QCK ; EP-CHECK QUEUE TYPE FILE
+1 WRITE !!,"Checking the QUEUE TYPE file..."
+2 NEW Q,N,DUP,D,DNO,DIK,DIC,X,Y,C,MISS,NAME,QIEN,CIEN
+3 SET (DIK,DIC)="^VEN(7.22,"
DUP ; DUP QUEUE TYPES
SET Q=""
SET DUP=""
+1 FOR
SET Q=$ORDER(^VEN(7.22,"B",Q))
IF Q=""
QUIT
SET N=$ORDER(^VEN(7.22,"B",Q,0))
SET D=$ORDER(^(N))
IF D
IF $LENGTH(DUP)
SET DUP=DUP_U
SET DUP=DUP_D
+2 IF '$LENGTH(DUP)
GOTO MIS
+3 WRITE !,"The file VEN EHP QUE TYPE has duplicate records that may cause problems",!,"Want to delete the duplicates"
+4 SET %=1
DO YN^DICN
IF %'=1
GOTO MIS
+5 FOR DNO=1:1:$LENGTH(DUP)
SET DA=$PIECE(DUP,U,DNO)
DO ^DIK
+6 WRITE !,"Duplicates removed!!"
KILL DUP
MIS ; MISSING QUEUE TYPES
+1 SET C=""
SET MISS=""
+2 FOR
SET C=$ORDER(^VEN(7.95,"B",C))
IF C=""
QUIT
IF '$DATA(^VEN(7.22,"B",C))
IF $LENGTH(MISS)
SET MISS=MISS_U
SET MISS=MISS_C
+3 IF '$LENGTH(MISS)
GOTO FIN
+4 WRITE !,"The following clinics are not found in the QUEUE TYPE file =>"
+5 FOR %=1:1:$LENGTH(MISS,U)
WRITE !?5,$PIECE(MISS,U,%)
+6 SET %=1
WRITE !!,"Want to add these to the QUEUE TYPE file"
+7 DO YN^DICN
IF %'=1
GOTO FIN
+8 SET DIC(0)="L"
SET DLAYGO=19707.22
SET DIC="^VEN(7.22,"
+9 FOR CNO=1:1:$LENGTH(MISS,U)
SET X=$PIECE(MISS,U,CNO)
IF $LENGTH(X)
DO ^DIC
IF $PIECE(Y,U,3)
WRITE !?5,$PIECE(Y,U,2)," added to the QUEUE TYPE file"
+10 KILL MISS
FIN SET NAME=""
FOR
SET NAME=$ORDER(^VEN(7.22,"B",NAME))
IF NAME=""
QUIT
SET QIEN=$ORDER(^VEN(7.22,"B",NAME,0))
SET CIEN=$ORDER(^VEN(7.95,"B",NAME,0))
IF QIEN
IF CIEN
SET $PIECE(^VEN(7.95,CIEN,1),U)=QIEN
+1 IF '$LENGTH($GET(DUP))
IF '$LENGTH($GET(MISS))
WRITE !,"The QUEUE TYPE file has been validated!!"
HANG 2
+2 DO ^XBFMK
+3 QUIT
+4 ;
+5 ; ---------------------------------------------------
+6 ;
CADD ; EP-ADD A NEW CLINIC
+1 NEW X,Y,%,DIEN,DIC,DIE,DR,DA,DLAYGO,POP,NAME
+2 WRITE !!?20,"***** ADD / EDIT A PCC+ CLINIC *****"
+3 WRITE !!,"To add a new clinic, answer the following questions"
+4 WRITE !,"At any time, you may enter '??' to see the choices",!!
+5 WRITE !,"Enter the name of the new clinic. It should be in the format:",!!?3,"{SITE} - {CLINIC} e.g., ANMC - PEDIATRICS or CROW - DENTAL",!
C1 SET DIC="^VEN(7.95,"
SET DIC(0)="AEQL"
SET DIC("A")="Clinic name: "
SET DLAYGO=19707.95
+1 DO ^DIC
IF Y=-1
GOTO CFIN
+2 SET DIE=DIC
SET (DA,DIEN)=+Y
SET NAME=$PIECE(Y,U,2)
+3 WRITE !!,"Enter the name of the DEPARTMENT (CLINIC STOP) associated with this clinic"
+4 SET DR="2.04////^S X=DUZ(2);.04"
LOCK +^VEN(7.95):0
IF $TEST
DO ^DIE
LOCK -^VEN(7.95)
+5 WRITE !!,"Enter the name of this clinic's DEFAULT ENCOUNTER FORM used during check-in"
+6 SET DR="2.05"
LOCK +^VEN(7.95):0
IF $TEST
DO ^DIE
LOCK -^VEN(7.95)
+7 WRITE !!,"Enter the name of this clinic's DEFAULT HEALTH SUMMARY used during check-in"
+8 SET DR="2.06"
LOCK +^VEN(7.95):0
IF $TEST
DO ^DIE
LOCK -^VEN(7.95)
+9 WRITE !!,"Enter the name of this clinic's DEFAULT PROVIDER used during check-in"
+10 SET DR="2.02"
LOCK +^VEN(7.95):0
IF $TEST
DO ^DIE
LOCK -^VEN(7.95)
+11 WRITE !!,"Enter the name of this clinic's HEALTH SUMMARY PRINT GROUP"
+12 SET DR="2.09"
LOCK +^VEN(7.95):0
IF $TEST
DO ^DIE
LOCK -^VEN(7.95)
+13 WRITE !!,"Enter the name of this clinic's ENCOUNTER FORM PRINT GROUP"
+14 SET DR="2.01"
LOCK +^VEN(7.95):0
IF $TEST
DO ^DIE
LOCK -^VEN(7.95)
+15 WRITE !!,"Does this clinic ever require an outguide request during check-in"
+16 SET %=1
DO YN^DICN
IF %=1
GOTO DQ
+17 SET DR="2.1////1"
LOCK +^VEN(7.95):0
IF $TEST
DO ^DIE
LOCK -^VEN(7.95)
DQ ; DESTINATION QUEUE TYPE
+1 SET Y=$ORDER(^VEN(7.22,"B",NAME,0))
IF Y
GOTO DQ1
+2 SET DIC="^VEN(7.22,"
SET DLAYGO=19707.22
SET DIC(0)="L"
SET X=""""_NAME_""""
+3 DO ^DIC
IF Y=-1
GOTO CFIN
DQ1 SET DIE="^VEN(7.95,"
SET DA=DIEN
SET DR="1.01////"_+Y
+1 LOCK +^VEN(7.95):0
IF $TEST
DO ^DIE
LOCK -^VEN(7.95)
+2 WRITE !!,"Enter the name of another clinic"
GOTO C1
CFIN DO ^XBFMK
+1 QUIT
+2 ;
CDEL ; EP-DELETE A CLINIC
+1 NEW X,Y,%,%Y,DIC,DIK,DA
+2 WRITE !!
+3 SET DIC("A")="Enter the name of the clinic you want to delete: "
+4 SET DIC="^VEN(7.95,"
SET DIC(0)="AEQL"
SET DLAYGO=19707.95
+5 DO ^DIC
IF Y=-1
GOTO CDFIN
+6 SET DA=+Y
SET NAME=$PIECE(Y,U,2)
+7 WRITE !,"Are you sure you want to delete ",$PIECE(Y,U,2)
+8 SET %=1
DO YN^DICN
IF %'=1
GOTO CDFIN
+9 SET DIK=DIC
+10 DO ^DIK
WRITE !,"Clinic deleted!!"
+11 SET DA=$ORDER(^VEN(7.22,"B",NAME,0))
+12 IF DA
SET DIK="^VEN(7.22,"
DO ^DIK
WRITE !,"The QUEUE TYPE '",NAME,"' has also been deleted"
CDFIN DO ^XBFMK
+1 QUIT
+2 ;
UNI ; EP-CHK VALIDITY OF UNIQUE CLINIC STATUS
+1 NEW UNI,%,CFG
+2 SET CFG=$$CFG^VENPCCU
+3 SET UNI=$PIECE($GET(^VEN(7.5,CFG,0)),U,6)
IF 'UNI
QUIT
+4 IF '$DATA(^VEN(7.95,UNI))
Begin DoDot:1
+5 SET $PIECE(^VEN(7.5,CFG,0),U,6)=""
+6 WRITE !,"Invalid unique clinic! Configuration file has been automatically repaired."
+7 QUIT
End DoDot:1
QUIT
+8 ; VALID UNIQUE FILE
SET %=$ORDER(^VEN(7.95,0))
IF '$ORDER(^VEN(7.95,%))
QUIT
+9 WRITE !,"The there is more than one PCC+ clinic registered!!",!,"Do you want to delete the unique clinic in the configuration file"
+10 SET %=1
DO YN^DICN
+11 IF %=1
SET $PIECE(^VEN(7.5,CFG,0),U,6)=""
+12 QUIT
+13 ;
