VENPCCMC.m

VENPCCMC ; IHS/OIT/GIS - PCC+ INSTALLATION CHECKER ;

 ;;2.6;PCC+;;NOV 12, 2007

 ;

 ;

 ; 

INTRO ; WELCOME

 N %,X,%Y,BACK,BYP,CDFN,CFG,CFIGIEN,CFLG,CIEN,CMED,DA,DEM,DP,GP,VER,EXRX,ART,AUTO,SM

 N I,IP,MON,MV,OS,PATH,PHS,POP,PULL,SOCK,STG,TIEN,TOT,TYPE,UNI,X,Y,SUB,IPFLG,CNT

 D ^XBCLS W !,?20,"*****  PCC+ INSTALLATION CHECKER  *****",!!

 W "NOTE: This utility does NOT update the PCC+ configuration files.",!," It simply reports on the status of the current installation."

 W !!,"When you see the '<>' symbol, press the <ENTER> key to continue scrolling..."

ENV ; CHECK THE OPERATING ENVIRONMENT

CSC26 I +$P($T(VENPCCMC+1),";",3)=2.6 W !!,"Now let's check connectivity and the Windows components of PCC+",! D CSC^VENPCCQX(.CNT) D PAUSE^VENPCCU G CPC ; CSC FOR VER 2.6

 W !!!!!,"First, let's check the operating environment..."

 I $$OS^VENPCCME W !,"Unable to proceed because the operating system is not defined for PCC+!" Q

CMP ; CHECK FOR REQUIRED COMPONENTS

 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1

 W ! I $$WAIT^VENPCCU

 D ^XBCLS

 W !!,"Next, let's make sure that all required components have been installed "

 D COMP^VENPCCME(.OUT)

 W !,OUT

 I OUT'["OK" D PAUSE^VENPCCU Q  ; KEY COMPONENTS ARE MISSING.  STOP HERE

 W ! I '$$WAIT^VENPCCU Q

CPC ; CHECK PRIMARY CONFIGURATION

 D ^XBCLS

 W !,"Checking the primary configuration..."

 S CFLG=0

 D CK^VENPCCME(.CFLG)

 I CFLG W !,"Please make all suggested corrections and then run this utility again" D PAUSE^VENPCCU Q

 W ! I '$$WAIT^VENPCCU Q

CCPS ; CHECK CONNECTION TO THE PRINT SERVERS

 D ^XBCLS

 W !,"Checking connectivity to the PCC+ print server(s)..."

 S IPFLG=0 D IP(.IPFLG)

 I IPFLG D  Q

 . W !!,"Make sure the PCC+ Print Service is running on the print server(s)"

 . W !,"If this is not successful, fix the LAN connection to the print server(s)."

 . W !,"Then run this utility again."

 . D PAUSE^VENPCCU

 . Q

 I 'IPFLG W !,"Connectivity is OK",!

 W ! I '$$WAIT^VENPCCU Q

CEF ; CHECK ENCOUNTER FORMS

 D ^XBCLS

 W !,"Checking PCC+ ENCOUNTER FORMS..."

 W !,"Only essential properties and template synchronization will be checked now."

 W !,"For managing all other TEMPLATE properties, use the TCU option.",!

 S CFLG=0

 D EF(.CFLG)

 I CFLG W !,"Please make all suggested corrections and then run this utility again" Q

 W ! I $$WAIT^VENPCCU

 W !!,"Checking PCC+ encounter form synchronization."

 D TEMPLATE^VENPCCM1

 I CFLG W !,"Please make all suggested corrections and then run this utility again" Q

 W ! I '$$WAIT^VENPCCU

 D ^XBCLS

CPG ; CHECK PRINT GROUPS

 D PG(.CFLG)

 I CFLG W !,"Please make all suggested corrections and then run this utility again" Q

 W !!,"Now let's check print group synchronization.",!

 D PG^VENPCCM1

 I CFLG W !,"Please make all suggested corrections and then run this utility again" Q

 W ! I '$$WAIT^VENPCCU

 D ^XBCLS

CCL ; CHECK CLINICS

 W !,"Checking PCC+ CLINICS..."

 W !,"Only the essential properties will be checked now."

 W !,"For managing all other CLINIC properties, use the TCC option.",!

 D CL(.CFLG)

 I CFLG W !,"Please make all suggested corrections and then run this utility again" Q

 W ! I '$$WAIT^VENPCCU

 D ^XBCLS

CHF ; CHECK HEADER FILES

 I $P($G(^VEN(7.5,$$CFG^VENPCCU,13)),U) W !,"New PCC+ data format IN USE.  No need for header files." D PAUSE^VENPCCU Q

 W !!,"Checking HEADER FILES..."

 D HF(.CFLG)

 I CFLG W !,"Please make all suggested corrections and then run this utility again"

 E  W !,"Header Files have been validated." W !!!,"CONGRATULATIONS!!!  Your PCC+ system has been valdated"

 D PAUSE^VENPCCU

 Q

 ; 

IP(IPFLG) ; EP - CHECK IP AND SOCKET

 N POP,X,I,ACK

 I $G(SOCK)'=5143 W !?5,"CURRENT TCP SOCKET IS INVALID.  IT SHOULD BE '5143'" S IPFLG=1 Q

 F I=1,2 S X=IP(I) D  Q:IP(1)=IP(2)  I IPFLG Q

 . I X'?1.3N1"."1.3N1"."1.3N1"."1.3N W !?5,"IP address ",I," is invalid.  Current address: ",X S IPFLG=1 Q

 . S %=$$OTCP^VENPCCP(X,5143)

 . I % W !?5,"Failed to establish a TCP/IP connection to ",X S IPFLG=1 Q

 . W ("ABOUT") W:$G(CACHE) ! K ACK R ACK:15

 . E  W !,"Print service not responding on ",IP(I) D CTCP^VENPCCP Q

 . I ACK'=0,ACK'=-7 W !,"Print service not responding on ",IP(I)

 . D CTCP^VENPCCP

 . W !?5,"Connection to print service on ",IP(I)," validated (Ver. "

 . W $S(ACK=0:"2.5",1:"2.2"),")."

 . Q

 Q

 ; 

EF(CFLG) ; EP-ENCOUTER FORMS

 N TOT,TIEN

 S TOT=0

 I '$O(^VEN(7.41,0)) W !?5,"NO ENCOUNTER FORM TEMPLATES HAVE BEEN ENTERED YET!" Q

 S TIEN=0 F  S TIEN=$O(^VEN(7.41,TIEN)) Q:'TIEN  I $D(^VEN(7.41,TIEN,0)) D

 . D ECK(TIEN)

 . S TOT=TOT+1

 . I '(TOT#10) W ! I $$WAIT^VENPCCU

 Q

 ;

ECK(TIEN) ; EP - CK TEMPLATE

 ; BAR CODE CHARACTER CHECK NO LONGER REQUIRED IN 2.2

 N STG,HDR,TMN,BAR,X,Y,NAME

 S NAME=$P($G(^VEN(7.41,TIEN,0)),U) W !?5,NAME

 S STG=^VEN(7.41,TIEN,0),HDR=$P(STG,U,2),TMN=$P(STG,U,3),BAR=$P(STG,U,4),CFLG=0

 I HDR'="ef",HDR'="25",HDR'="pn",HDR'="fp" W !?7,"Invalid/missing header mnemonic." S CFLG=1

 I TMN="" W !?7,"Missing template mnemonic" S CFLG=1 Q

 I TMN'?1.10L W !?7,"Invalid template mnemonic.  Must be 1-10 lowercase letters - no spaces." S CFLG=1 Q

 S X=0 F  S X=$O(^VEN(7.41,X)) Q:'X  I X'=TIEN S Y=$P($G(^VEN(7.41,X,0)),U,3) I Y=TMN W !?7,"The mnemonic '"_Y_"' is not unioque." S CFLG=1 Q

 I 'CFLG W "  <= OK"

 Q

 ; 

HF(CFLG) ; EP - HEADER FILES

 N CFIGIEN,PATH,HF,IPI,IPX,HSTG,X

 S CFIGIEN=$$CFG^VENPCCU

 S PATH=$G(^VEN(7.5,CFIGIEN,2))

 I PATH="" W !,"Unable to find the Path to the header files on the RPMS Server!" Q

 F HF="efheader.txt","25header.txt","hsheader.txt" D

 . I $$FIND^VENPCCP(PATH,HF) W !,"Header file ",HF," has been validated" Q

 . W !,"Header file '",HF,"'can not be located in ",PATH

 . Q

 W !!,"Accessing information...",!

 S IPX=2 I IP(1)=IP(2) S IPX=1

 F HF="ef_header.txt","25_header.txt","hs_header.txt" F IPI=1:1:IPX D

 . S HSTG=$$FILE^VENPCCM2("c:\program files\ilc\ilc forms print service\templates\"_HF,IP(IPI))

 . I $L(HSTG)>1 W !,HF," is properly synchronized on Print Server #"_IPI Q

 . W !,HF," has not been loaded on Print Server #",IPI S CFLG=1

 . Q

 Q  ; HEADER FILE COMPARISON NO LONGER REQUIRED

 ; 

PG(CFLG) ; EP-PRINT GROUPS

 W !!,"CHECKING PRINT GROUPS..."

 I '$O(^VEN(7.4,0)) W !?5,"NO PRINT GROUPS HAVE BEEN ENTERED YET!" Q

 S X=0 F  S X=$O(^VEN(7.4,X)) Q:'X  S Y=$P($G(^VEN(7.4,X,0)),U,2) I Y Q

 I 'Y W !?7,"No MEDICAL RECORDS print group has been defined." S CFLG=1 Q

 S (X,TOT)=0 F  S X=$O(^VEN(7.4,X)) Q:'X  D

 . W !?5,$P($G(^VEN(7.4,X,0)),U)

 . I $P(^VEN(7.4,X,0),U,2) W " (MEDICAL RECORDS PRINT GROUP)" S TOT=TOT+1

 . I $P($G(^VEN(7.4,X,0)),U)'["_" W !,?7,"Name not is recommended format: Facility_Group e.g., 'GIMC_ORTHO'"

 . E  W "  <=OK"

 . Q

 I TOT>1 W !,"There is more than one Medical Records print group!" S CFLG=1 Q

 Q

 ; 

CL(CFLG) ; EP-CLINICS

 N DIC,DIE,DA,DR,X,CIEN

 S CIEN=0,TOT=0

 F TOT=1:1 S CIEN=$O(^VEN(7.95,CIEN)) Q:'CIEN  D CCK(CIEN)

 F X="TELEPHONE ENCOUNTER","MEDICAL RECORDS" I '$D(^VEN(7.95,"B",X)) D

 . S NAME=X,X=""""_X_""""

 . S DIC="^VEN(7.95,",DIC(0)="L",DLAYGO=19707.95

 . D ^DIC I Y=-1 Q

 . S CIEN=+Y

 . S %=$O(^VEN(7.22,"B",NAME,0))

 . I % D  I 1 ; JUST NEED TO MAKE THE CONNECTION

 .. S DIE="^VEN(7.95,",DA=CIEN,DR="1.01////"_%_";2.07////1"

 .. L +^VEN(7.95,DA):0 D ^DIE L -^VEN(7.95,DA)

 .. Q

 . E  D

 .. S X=""""_NAME_"""",DIC="^VEN(7.22,",DIC(0)="L",DLAYGO=19707.22

 .. D ^DIC I Y=-1 Q  ; UPDATE THE QUEUE TYPE FILE

 .. S DIE="^VEN(7.95,",DA=CIEN,DR="1.01////"_+Y_";2.07////1"

 .. L +^VEN(7.95,DA):0 D ^DIE L -^VEN(7.95,DA) ; MAKE THE CONNECTION

 .. Q

 . W !?5,X," has been added to the VEN EHP CLINIC file & VEN QUEUE TYPE file."

 . Q

 D ^XBFMK

 Q

 ; 

CCK(CIEN) ; EP-CHECK CLINIC

 N A,B,NAME,DEPT,PGRP,DPRV,DEF,DHS,INST,QUE,QIEN,DIC,DIE,DA,DR,X,Y,%

 S A=$G(^VEN(7.95,CIEN,0)),B=$G(^VEN(7.95,CIEN,2))

 S NAME=$P(A,U),CFLG=0

 S TOT=TOT+1 I '(TOT#10) W ! I $$WAIT^VENPCCU

 W !?5,NAME W:$P(B,U,3) " (TRIAGE MODULE ACTIVE)"

 I NAME'="MEDICAL RECORDS",NAME'="TELEPHONE ENCOUNTER",NAME'="CHART REVIEW"

 E  W "  <=OK" Q

 I NAME'[" - " W !?10,"USE VALID NAME FORMAT: 'Facility - Clinic'; e.g., PIMC - PEDIATRICS"

 S DEPT=$P(A,U,4) I DEPT="" W !?10,"UNKNOWN CLINIC STOP" S CFLG=1

 E  I '$D(^DIC(40.7,DEPT,0)) W !?10,"INVALID CLINIC STOP" S CFLG=1

 S PGRP=$P(B,U,1) I PGRP="" W !?10,"UNKNOWN PRINT GROUP" S CFLG=1

 E  I '$D(^VEN(7.4,PGRP,0)) W !?10,"INVALID PRINT GROUP" S CFLG=1

 S DPRV=$P(B,U,2) I DPRV="" W !?10,"UNKNOWN DEFAULT PROVIDER" S CFLG=1

 E  I '$D(^VA(200,DPRV,0)) W !?10,"INVALID DEFAULT PROVIDER" S CFLG=1

 S DEF=$P(B,U,5) I DEF="" W !?10,"UNKNOWN DEFAULT ENCOUNTER FORM" S CFLG=1

 E  I '$D(^VEN(7.41,DEF,0)) W !?10,"INVALID DEFAULT ENCOUTER FORM" S CFLG=1

 S INST=$P(B,U,4) I INST="" W !?10,"UNKNOWN MEDICAL RECORDS LOCATION" S CFLG=1

 E  I '$D(^DIC(4,INST,0)) W !?10,"INVALID MEDICAL RECORDS LOCATION" S CFLG=1 G CCK1

 S QIEN=$P($G(^VEN(7.95,CIEN,1)),U) I 'QIEN D  ; QUEUE TYPE FILE LINKAGE

 . S %=$O(^VEN(7.22,"B",NAME,0))

 . I % D  Q  ; JUST NEED TO MAKE THE CONNECTION

 .. S DIE="^VEN(7.95,",DA=CIEN,DR="1.01////"_%

 .. L +^VEN(7.95,DA):0 D ^DIE L -^VEN(7.95,DA)

 .. W !?10,"Clinic registered in QUEUE TYPE file"

 .. Q

 . S X=""""_NAME_"""",DIC="^VEN(7.22,",DIC(0)="L",DLAYGO=19707.22

 . D ^DIC I Y=-1 Q  ; UPDATE THE QUEUE TYPE FILE

 . S DA=+Y S DIE="^VEN(7.95,",DA=CIEN,DR="1.01////"_DA

 . L +^VEN(7.95,DA):0 D ^DIE L -^VEN(7.95,DA) ; MAKE THE CONNECTION

 . D ^XBFMK

 . W !?10,"QUEUE TYPE file has been updated"

 . Q

CCK1 I $P(B,U,7) W !?10,"INACTIVE CLINIC" Q

 I 'CFLG W "  <=OK"

 Q

 ; 

VENPCCMC  ; IHS/OIT/GIS - PCC+ INSTALLATION CHECKER ;

 +1       ;;2.6;PCC+;;NOV 12, 2007

 +2       ;

 +3       ;

 +4       ; 

INTRO     ; WELCOME

 +1        NEW %,X,%Y,BACK,BYP,CDFN,CFG,CFIGIEN,CFLG,CIEN,CMED,DA,DEM,DP,GP,VER,EXRX,ART,AUTO,SM

 +2        NEW I,IP,MON,MV,OS,PATH,PHS,POP,PULL,SOCK,STG,TIEN,TOT,TYPE,UNI,X,Y,SUB,IPFLG,CNT

 +3        DO ^XBCLS

           WRITE !,?20,"*****  PCC+ INSTALLATION CHECKER  *****",!!

 +4        WRITE "NOTE: This utility does NOT update the PCC+ configuration files.",!," It simply reports on the status of the current installation."

 +5        WRITE !!,"When you see the '<>' symbol, press the <ENTER> key to continue scrolling..."

ENV       ; CHECK THE OPERATING ENVIRONMENT

CSC26     ; CSC FOR VER 2.6

           IF +$PIECE($TEXT(VENPCCMC+1),";",3)=2.6

               WRITE !!,"Now let's check connectivity and the Windows components of PCC+",!

               DO CSC^VENPCCQX(.CNT)

               DO PAUSE^VENPCCU

               GOTO CPC

 +1        WRITE !!!!!,"First, let's check the operating environment..."

 +2        IF $$OS^VENPCCME

               WRITE !,"Unable to proceed because the operating system is not defined for PCC+!"

               QUIT 

CMP       ; CHECK FOR REQUIRED COMPONENTS

 +1       ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1

 +2        WRITE !

           IF $$WAIT^VENPCCU

 +3        DO ^XBCLS

 +4        WRITE !!,"Next, let's make sure that all required components have been installed "

 +5        DO COMP^VENPCCME(.OUT)

 +6        WRITE !,OUT

 +7       ; KEY COMPONENTS ARE MISSING.  STOP HERE

           IF OUT'["OK"

               DO PAUSE^VENPCCU

               QUIT 

 +8        WRITE !

           IF '$$WAIT^VENPCCU

               QUIT 

CPC       ; CHECK PRIMARY CONFIGURATION

 +1        DO ^XBCLS

 +2        WRITE !,"Checking the primary configuration..."

 +3        SET CFLG=0

 +4        DO CK^VENPCCME(.CFLG)

 +5        IF CFLG

               WRITE !,"Please make all suggested corrections and then run this utility again"

               DO PAUSE^VENPCCU

               QUIT 

 +6        WRITE !

           IF '$$WAIT^VENPCCU

               QUIT 

CCPS      ; CHECK CONNECTION TO THE PRINT SERVERS

 +1        DO ^XBCLS

 +2        WRITE !,"Checking connectivity to the PCC+ print server(s)..."

 +3        SET IPFLG=0

           DO IP(.IPFLG)

 +4        IF IPFLG

               Begin DoDot:1

 +5                WRITE !!,"Make sure the PCC+ Print Service is running on the print server(s)"

 +6                WRITE !,"If this is not successful, fix the LAN connection to the print server(s)."

 +7                WRITE !,"Then run this utility again."

 +8                DO PAUSE^VENPCCU

 +9                QUIT 

               End DoDot:1

               QUIT 

 +10       IF 'IPFLG

               WRITE !,"Connectivity is OK",!

 +11       WRITE !

           IF '$$WAIT^VENPCCU

               QUIT 

CEF       ; CHECK ENCOUNTER FORMS

 +1        DO ^XBCLS

 +2        WRITE !,"Checking PCC+ ENCOUNTER FORMS..."

 +3        WRITE !,"Only essential properties and template synchronization will be checked now."

 +4        WRITE !,"For managing all other TEMPLATE properties, use the TCU option.",!

 +5        SET CFLG=0

 +6        DO EF(.CFLG)

 +7        IF CFLG

               WRITE !,"Please make all suggested corrections and then run this utility again"

               QUIT 

 +8        WRITE !

           IF $$WAIT^VENPCCU

 +9        WRITE !!,"Checking PCC+ encounter form synchronization."

 +10       DO TEMPLATE^VENPCCM1

 +11       IF CFLG

               WRITE !,"Please make all suggested corrections and then run this utility again"

               QUIT 

 +12       WRITE !

           IF '$$WAIT^VENPCCU

 +13       DO ^XBCLS

CPG       ; CHECK PRINT GROUPS

 +1        DO PG(.CFLG)

 +2        IF CFLG

               WRITE !,"Please make all suggested corrections and then run this utility again"

               QUIT 

 +3        WRITE !!,"Now let's check print group synchronization.",!

 +4        DO PG^VENPCCM1

 +5        IF CFLG

               WRITE !,"Please make all suggested corrections and then run this utility again"

               QUIT 

 +6        WRITE !

           IF '$$WAIT^VENPCCU

 +7        DO ^XBCLS

CCL       ; CHECK CLINICS

 +1        WRITE !,"Checking PCC+ CLINICS..."

 +2        WRITE !,"Only the essential properties will be checked now."

 +3        WRITE !,"For managing all other CLINIC properties, use the TCC option.",!

 +4        DO CL(.CFLG)

 +5        IF CFLG

               WRITE !,"Please make all suggested corrections and then run this utility again"

               QUIT 

 +6        WRITE !

           IF '$$WAIT^VENPCCU

 +7        DO ^XBCLS

CHF       ; CHECK HEADER FILES

 +1        IF $PIECE($GET(^VEN(7.5,$$CFG^VENPCCU,13)),U)

               WRITE !,"New PCC+ data format IN USE.  No need for header files."

               DO PAUSE^VENPCCU

               QUIT 

 +2        WRITE !!,"Checking HEADER FILES..."

 +3        DO HF(.CFLG)

 +4        IF CFLG

               WRITE !,"Please make all suggested corrections and then run this utility again"

 +5       IF '$TEST

               WRITE !,"Header Files have been validated."

               WRITE !!!,"CONGRATULATIONS!!!  Your PCC+ system has been valdated"

 +6        DO PAUSE^VENPCCU

 +7        QUIT 

 +8       ; 

IP(IPFLG) ; EP - CHECK IP AND SOCKET

 +1        NEW POP,X,I,ACK

 +2        IF $GET(SOCK)'=5143

               WRITE !?5,"CURRENT TCP SOCKET IS INVALID.  IT SHOULD BE '5143'"

               SET IPFLG=1

               QUIT 

 +3        FOR I=1,2

               SET X=IP(I)

               Begin DoDot:1

 +4                IF X'?1.3N1"."1.3N1"."1.3N1"."1.3N

                       WRITE !?5,"IP address ",I," is invalid.  Current address: ",X

                       SET IPFLG=1

                       QUIT 

 +5                SET %=$$OTCP^VENPCCP(X,5143)

 +6                IF %

                       WRITE !?5,"Failed to establish a TCP/IP connection to ",X

                       SET IPFLG=1

                       QUIT 

 +7                WRITE ("ABOUT")

                   IF $GET(CACHE)

                       WRITE !

                   KILL ACK

                   READ ACK:15

 +8               IF '$TEST

                       WRITE !,"Print service not responding on ",IP(I)

                       DO CTCP^VENPCCP

                       QUIT 

 +9                IF ACK'=0

                       IF ACK'=-7

                           WRITE !,"Print service not responding on ",IP(I)

 +10               DO CTCP^VENPCCP

 +11               WRITE !?5,"Connection to print service on ",IP(I)," validated (Ver. "

 +12               WRITE $SELECT(ACK=0:"2.5",1:"2.2"),")."

 +13               QUIT 

               End DoDot:1

               IF IP(1)=IP(2)

                   QUIT 

               IF IPFLG

                   QUIT 

 +14       QUIT 

 +15      ; 

EF(CFLG)  ; EP-ENCOUTER FORMS

 +1        NEW TOT,TIEN

 +2        SET TOT=0

 +3        IF '$ORDER(^VEN(7.41,0))

               WRITE !?5,"NO ENCOUNTER FORM TEMPLATES HAVE BEEN ENTERED YET!"

               QUIT 

 +4        SET TIEN=0

           FOR 

               SET TIEN=$ORDER(^VEN(7.41,TIEN))

               IF 'TIEN

                   QUIT 

               IF $DATA(^VEN(7.41,TIEN,0))

                   Begin DoDot:1

 +5                    DO ECK(TIEN)

 +6                    SET TOT=TOT+1

 +7                    IF '(TOT#10)

                           WRITE !

                           IF $$WAIT^VENPCCU

                   End DoDot:1

 +8        QUIT 

 +9       ;

ECK(TIEN) ; EP - CK TEMPLATE

 +1       ; BAR CODE CHARACTER CHECK NO LONGER REQUIRED IN 2.2

 +2        NEW STG,HDR,TMN,BAR,X,Y,NAME

 +3        SET NAME=$PIECE($GET(^VEN(7.41,TIEN,0)),U)

           WRITE !?5,NAME

 +4        SET STG=^VEN(7.41,TIEN,0)

           SET HDR=$PIECE(STG,U,2)

           SET TMN=$PIECE(STG,U,3)

           SET BAR=$PIECE(STG,U,4)

           SET CFLG=0

 +5        IF HDR'="ef"

               IF HDR'="25"

                   IF HDR'="pn"

                       IF HDR'="fp"

                           WRITE !?7,"Invalid/missing header mnemonic."

                           SET CFLG=1

 +6        IF TMN=""

               WRITE !?7,"Missing template mnemonic"

               SET CFLG=1

               QUIT 

 +7        IF TMN'?1.10L

               WRITE !?7,"Invalid template mnemonic.  Must be 1-10 lowercase letters - no spaces."

               SET CFLG=1

               QUIT 

 +8        SET X=0

           FOR 

               SET X=$ORDER(^VEN(7.41,X))

               IF 'X

                   QUIT 

               IF X'=TIEN

                   SET Y=$PIECE($GET(^VEN(7.41,X,0)),U,3)

                   IF Y=TMN

                       WRITE !?7,"The mnemonic '"_Y_"' is not unioque."

                       SET CFLG=1

                       QUIT 

 +9        IF 'CFLG

               WRITE "  <= OK"

 +10       QUIT 

 +11      ; 

HF(CFLG)  ; EP - HEADER FILES

 +1        NEW CFIGIEN,PATH,HF,IPI,IPX,HSTG,X

 +2        SET CFIGIEN=$$CFG^VENPCCU

 +3        SET PATH=$GET(^VEN(7.5,CFIGIEN,2))

 +4        IF PATH=""

               WRITE !,"Unable to find the Path to the header files on the RPMS Server!"

               QUIT 

 +5        FOR HF="efheader.txt","25header.txt","hsheader.txt"

               Begin DoDot:1

 +6                IF $$FIND^VENPCCP(PATH,HF)

                       WRITE !,"Header file ",HF," has been validated"

                       QUIT 

 +7                WRITE !,"Header file '",HF,"'can not be located in ",PATH

 +8                QUIT 

               End DoDot:1

 +9        WRITE !!,"Accessing information...",!

 +10       SET IPX=2

           IF IP(1)=IP(2)

               SET IPX=1

 +11       FOR HF="ef_header.txt","25_header.txt","hs_header.txt"

               FOR IPI=1:1:IPX

                   Begin DoDot:1

 +12                   SET HSTG=$$FILE^VENPCCM2("c:\program files\ilc\ilc forms print service\templates\"_HF,IP(IPI))

 +13                   IF $LENGTH(HSTG)>1

                           WRITE !,HF," is properly synchronized on Print Server #"_IPI

                           QUIT 

 +14                   WRITE !,HF," has not been loaded on Print Server #",IPI

                       SET CFLG=1

 +15                   QUIT 

                   End DoDot:1

 +16      ; HEADER FILE COMPARISON NO LONGER REQUIRED

           QUIT 

 +17      ; 

PG(CFLG)  ; EP-PRINT GROUPS

 +1        WRITE !!,"CHECKING PRINT GROUPS..."

 +2        IF '$ORDER(^VEN(7.4,0))

               WRITE !?5,"NO PRINT GROUPS HAVE BEEN ENTERED YET!"

               QUIT 

 +3        SET X=0

           FOR 

               SET X=$ORDER(^VEN(7.4,X))

               IF 'X

                   QUIT 

               SET Y=$PIECE($GET(^VEN(7.4,X,0)),U,2)

               IF Y

                   QUIT 

 +4        IF 'Y

               WRITE !?7,"No MEDICAL RECORDS print group has been defined."

               SET CFLG=1

               QUIT 

 +5        SET (X,TOT)=0

           FOR 

               SET X=$ORDER(^VEN(7.4,X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +6                WRITE !?5,$PIECE($GET(^VEN(7.4,X,0)),U)

 +7                IF $PIECE(^VEN(7.4,X,0),U,2)

                       WRITE " (MEDICAL RECORDS PRINT GROUP)"

                       SET TOT=TOT+1

 +8                IF $PIECE($GET(^VEN(7.4,X,0)),U)'["_"

                       WRITE !,?7,"Name not is recommended format: Facility_Group e.g., 'GIMC_ORTHO'"

 +9               IF '$TEST

                       WRITE "  <=OK"

 +10               QUIT 

               End DoDot:1

 +11       IF TOT>1

               WRITE !,"There is more than one Medical Records print group!"

               SET CFLG=1

               QUIT 

 +12       QUIT 

 +13      ; 

CL(CFLG)  ; EP-CLINICS

 +1        NEW DIC,DIE,DA,DR,X,CIEN

 +2        SET CIEN=0

           SET TOT=0

 +3        FOR TOT=1:1

               SET CIEN=$ORDER(^VEN(7.95,CIEN))

               IF 'CIEN

                   QUIT 

               DO CCK(CIEN)

 +4        FOR X="TELEPHONE ENCOUNTER","MEDICAL RECORDS"

               IF '$DATA(^VEN(7.95,"B",X))

                   Begin DoDot:1

 +5                    SET NAME=X

                       SET X=""""_X_""""

 +6                    SET DIC="^VEN(7.95,"

                       SET DIC(0)="L"

                       SET DLAYGO=19707.95

 +7                    DO ^DIC

                       IF Y=-1

                           QUIT 

 +8                    SET CIEN=+Y

 +9                    SET %=$ORDER(^VEN(7.22,"B",NAME,0))

 +10      ; JUST NEED TO MAKE THE CONNECTION

                       IF %

                           Begin DoDot:2

 +11                           SET DIE="^VEN(7.95,"

                               SET DA=CIEN

                               SET DR="1.01////"_%_";2.07////1"

 +12                           LOCK +^VEN(7.95,DA):0

                               DO ^DIE

                               LOCK -^VEN(7.95,DA)

 +13                           QUIT 

                           End DoDot:2

                           IF 1

 +14                  IF '$TEST

                           Begin DoDot:2

 +15                           SET X=""""_NAME_""""

                               SET DIC="^VEN(7.22,"

                               SET DIC(0)="L"

                               SET DLAYGO=19707.22

 +16      ; UPDATE THE QUEUE TYPE FILE

                               DO ^DIC

                               IF Y=-1

                                   QUIT 

 +17                           SET DIE="^VEN(7.95,"

                               SET DA=CIEN

                               SET DR="1.01////"_+Y_";2.07////1"

 +18      ; MAKE THE CONNECTION

                               LOCK +^VEN(7.95,DA):0

                               DO ^DIE

                               LOCK -^VEN(7.95,DA)

 +19                           QUIT 

                           End DoDot:2

 +20                   WRITE !?5,X," has been added to the VEN EHP CLINIC file & VEN QUEUE TYPE file."

 +21                   QUIT 

                   End DoDot:1

 +22       DO ^XBFMK

 +23       QUIT 

 +24      ; 

CCK(CIEN) ; EP-CHECK CLINIC

 +1        NEW A,B,NAME,DEPT,PGRP,DPRV,DEF,DHS,INST,QUE,QIEN,DIC,DIE,DA,DR,X,Y,%

 +2        SET A=$GET(^VEN(7.95,CIEN,0))

           SET B=$GET(^VEN(7.95,CIEN,2))

 +3        SET NAME=$PIECE(A,U)

           SET CFLG=0

 +4        SET TOT=TOT+1

           IF '(TOT#10)

               WRITE !

               IF $$WAIT^VENPCCU

 +5        WRITE !?5,NAME

           IF $PIECE(B,U,3)

               WRITE " (TRIAGE MODULE ACTIVE)"

 +6        IF NAME'="MEDICAL RECORDS"

               IF NAME'="TELEPHONE ENCOUNTER"

                   IF NAME'="CHART REVIEW"

 +7       IF '$TEST

               WRITE "  <=OK"

               QUIT 

 +8        IF NAME'[" - "

               WRITE !?10,"USE VALID NAME FORMAT: 'Facility - Clinic'; e.g., PIMC - PEDIATRICS"

 +9        SET DEPT=$PIECE(A,U,4)

           IF DEPT=""

               WRITE !?10,"UNKNOWN CLINIC STOP"

               SET CFLG=1

 +10      IF '$TEST

               IF '$DATA(^DIC(40.7,DEPT,0))

                   WRITE !?10,"INVALID CLINIC STOP"

                   SET CFLG=1

 +11       SET PGRP=$PIECE(B,U,1)

           IF PGRP=""

               WRITE !?10,"UNKNOWN PRINT GROUP"

               SET CFLG=1

 +12      IF '$TEST

               IF '$DATA(^VEN(7.4,PGRP,0))

                   WRITE !?10,"INVALID PRINT GROUP"

                   SET CFLG=1

 +13       SET DPRV=$PIECE(B,U,2)

           IF DPRV=""

               WRITE !?10,"UNKNOWN DEFAULT PROVIDER"

               SET CFLG=1

 +14      IF '$TEST

               IF '$DATA(^VA(200,DPRV,0))

                   WRITE !?10,"INVALID DEFAULT PROVIDER"

                   SET CFLG=1

 +15       SET DEF=$PIECE(B,U,5)

           IF DEF=""

               WRITE !?10,"UNKNOWN DEFAULT ENCOUNTER FORM"

               SET CFLG=1

 +16      IF '$TEST

               IF '$DATA(^VEN(7.41,DEF,0))

                   WRITE !?10,"INVALID DEFAULT ENCOUTER FORM"

                   SET CFLG=1

 +17       SET INST=$PIECE(B,U,4)

           IF INST=""

               WRITE !?10,"UNKNOWN MEDICAL RECORDS LOCATION"

               SET CFLG=1

 +18      IF '$TEST

               IF '$DATA(^DIC(4,INST,0))

                   WRITE !?10,"INVALID MEDICAL RECORDS LOCATION"

                   SET CFLG=1

                   GOTO CCK1

 +19      ; QUEUE TYPE FILE LINKAGE

           SET QIEN=$PIECE($GET(^VEN(7.95,CIEN,1)),U)

           IF 'QIEN

               Begin DoDot:1

 +20               SET %=$ORDER(^VEN(7.22,"B",NAME,0))

 +21      ; JUST NEED TO MAKE THE CONNECTION

                   IF %

                       Begin DoDot:2

 +22                       SET DIE="^VEN(7.95,"

                           SET DA=CIEN

                           SET DR="1.01////"_%

 +23                       LOCK +^VEN(7.95,DA):0

                           DO ^DIE

                           LOCK -^VEN(7.95,DA)

 +24                       WRITE !?10,"Clinic registered in QUEUE TYPE file"

 +25                       QUIT 

                       End DoDot:2

                       QUIT 

 +26               SET X=""""_NAME_""""

                   SET DIC="^VEN(7.22,"

                   SET DIC(0)="L"

                   SET DLAYGO=19707.22

 +27      ; UPDATE THE QUEUE TYPE FILE

                   DO ^DIC

                   IF Y=-1

                       QUIT 

 +28               SET DA=+Y

                   SET DIE="^VEN(7.95,"

                   SET DA=CIEN

                   SET DR="1.01////"_DA

 +29      ; MAKE THE CONNECTION

                   LOCK +^VEN(7.95,DA):0

                   DO ^DIE

                   LOCK -^VEN(7.95,DA)

 +30               DO ^XBFMK