Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VENPCCM3

VENPCCM3.m

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