- 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 ;