ECTDIR.m

ECTDIR ;B'ham ISC/PTD-Direct Call to an External Routine ;01/29/91 08:00

V ;;1.05;INTERIM MANAGEMENT SUPPORT;**2,14**;

 ;VARIABLE 'ECT1' MUST BE DEFINED - IT IDENTIFIES INFORMATION ABOUT THE EXTERNAL ROUTINE TO BE CALLED

 G:'$D(ECT1) EXIT I ECT1="NUR" D NURSV I $D(XQUIT) W *7,!,"Unable to determine version of NURSING operating on your system." G EXIT

VRFY S INFO=$P($T(@ECT1),";;",2),GLRT=$P(INFO,"~"),GREF=$P(INFO,"~",2),FNAM=$P(INFO,"~",3),FNUM=$P(INFO,"~",4),RTN=$P(INFO,"~",5)

 I '$D(@GLRT) W *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The '"_FNAM_"' File -",!,"file number "_FNUM_" is not loaded on your system.",!! S XQUIT="" G EXIT

 I '$O(@GREF) W *7,!!,"'"_FNAM_"' File -",!,"file number "_FNUM_" has not been populated on your system.",!! S XQUIT="" G EXIT

 S X=$P(RTN,"^",2) X ^%ZOSF("TEST") I $T=0 W *7,!!,RTN," routine does not exist on your system!" G EXIT

 K %ZIS S IOP="HOME" D ^%ZIS K %ZIS,IOP W @IOF,!!

CALL ;DIRECT CALL TO EXTERNAL ROUTINE

 D @RTN

EXIT K %,%T,%X,%Y,B,C,DA,DD,DFN,DIE,DIC,ECT1,ENHI,ENLO,ENTEMP,ENTNX,FNAM,FNUM,GLRT,GREF,INFO,J,K,N,P,PKGDA,POP,R,RTN,VA,VER,X,X1,XY,Y,Z3

 Q

 ;

NURSV ;DETERMINE VERSION OF NURSING PACKAGE

 S PKGDA=$O(^DIC(9.4,"C","NURS",0)) I 'PKGDA S XQUIT="" Q

 S:$D(^DIC(9.4,PKGDA,"VERSION")) VER=+(^("VERSION")) I '$D(VER) S XQUIT="" Q

 S ECT1=$S(VER>2:"NUR2",1:"NUR1")

 Q

 ;

XTRNL ;DATA FOR EXTERNAL ROUTINE CALLS

UD ;;^PS(57.6)~^PS(57.6,0)~Unit Dose Pick List Stats~57.6~^PSGAMS

UDP ;;^PS(57.6)~^PS(57.6,0)~Unit Dose Pick List Stats~57.6~^PSGPRVR

UDS ;;^PS(57.6)~^PS(57.6,0)~Unit Dose Pick List Stats~57.6~^PSGSCT

NUR1 ;;^NURSF(213.1)~^NURSF(213.1,0)~Nurs AMIS 1106 Class~213.1~EN1^NURSAWL0

NUR2 ;;^NURSA(213.1)~^NURSA(213.1,0)~Nurs AMIS 1106 Class~213.1~EN1^NURSAWL0

DENT ;;^DENT(221)~^DENT(221,0)~Dental Treatment (AMIS)~221~^DENTP1

CONS ;;^ENG("PROJ")~^ENG("PROJ",0)~Construction Project~6925~SINGLE^ENPRP

SPACE ;;^ENG("SP")~^ENG("SP",0)~Eng Space~6928~ENT^ENSP2

EQT ;;^ENG(6914)~^ENG(6914,0)~Equipment Inv.~6914~DS^ENEQ1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECTDIR   2005     printed  Apr 09, 2024@21:05:12                                                                                                                                                                                                      Page 2

ECTDIR    ;B'ham ISC/PTD-Direct Call to an External Routine ;01/29/91 08:00

V         ;;1.05;INTERIM MANAGEMENT SUPPORT;**2,14**;

 +1       ;VARIABLE 'ECT1' MUST BE DEFINED - IT IDENTIFIES INFORMATION ABOUT THE EXTERNAL ROUTINE TO BE CALLED

 +2        if '$DATA(ECT1)

               GOTO EXIT

           IF ECT1="NUR"

               DO NURSV

               IF $DATA(XQUIT)

                   WRITE *7,!,"Unable to determine version of NURSING operating on your system."

                   GOTO EXIT

VRFY       SET INFO=$PIECE($TEXT(@ECT1),";;",2)

           SET GLRT=$PIECE(INFO,"~")

           SET GREF=$PIECE(INFO,"~",2)

           SET FNAM=$PIECE(INFO,"~",3)

           SET FNUM=$PIECE(INFO,"~",4)

           SET RTN=$PIECE(INFO,"~",5)

 +1        IF '$DATA(@GLRT)

               WRITE *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The '"_FNAM_"' File -",!,"file number "_FNUM_" is not loaded on your system.",!!

               SET XQUIT=""

               GOTO EXIT

 +2        IF '$ORDER(@GREF)

               WRITE *7,!!,"'"_FNAM_"' File -",!,"file number "_FNUM_" has not been populated on your system.",!!

               SET XQUIT=""

               GOTO EXIT

 +3        SET X=$PIECE(RTN,"^",2)

           XECUTE ^%ZOSF("TEST")

           IF $TEST=0

               WRITE *7,!!,RTN," routine does not exist on your system!"

               GOTO EXIT

 +4        KILL %ZIS

           SET IOP="HOME"

           DO ^%ZIS

           KILL %ZIS,IOP

           WRITE @IOF,!!

CALL      ;DIRECT CALL TO EXTERNAL ROUTINE

 +1        DO @RTN

EXIT       KILL %,%T,%X,%Y,B,C,DA,DD,DFN,DIE,DIC,ECT1,ENHI,ENLO,ENTEMP,ENTNX,FNAM,FNUM,GLRT,GREF,INFO,J,K,N,P,PKGDA,POP,R,RTN,VA,VER,X,X1,XY,Y,Z3

 +1        QUIT 

 +2       ;

NURSV     ;DETERMINE VERSION OF NURSING PACKAGE

 +1        SET PKGDA=$ORDER(^DIC(9.4,"C","NURS",0))

           IF 'PKGDA

               SET XQUIT=""

               QUIT 

 +2        if $DATA(^DIC(9.4,PKGDA,"VERSION"))

               SET VER=+(^("VERSION"))

           IF '$DATA(VER)

               SET XQUIT=""

               QUIT 

 +3        SET ECT1=$SELECT(VER>2:"NUR2",1:"NUR1")

 +4        QUIT 

 +5       ;

XTRNL     ;DATA FOR EXTERNAL ROUTINE CALLS

UD        ;;^PS(57.6)~^PS(57.6,0)~Unit Dose Pick List Stats~57.6~^PSGAMS

UDP       ;;^PS(57.6)~^PS(57.6,0)~Unit Dose Pick List Stats~57.6~^PSGPRVR

UDS       ;;^PS(57.6)~^PS(57.6,0)~Unit Dose Pick List Stats~57.6~^PSGSCT

NUR1      ;;^NURSF(213.1)~^NURSF(213.1,0)~Nurs AMIS 1106 Class~213.1~EN1^NURSAWL0

NUR2      ;;^NURSA(213.1)~^NURSA(213.1,0)~Nurs AMIS 1106 Class~213.1~EN1^NURSAWL0

DENT      ;;^DENT(221)~^DENT(221,0)~Dental Treatment (AMIS)~221~^DENTP1

CONS      ;;^ENG("PROJ")~^ENG("PROJ",0)~Construction Project~6925~SINGLE^ENPRP

SPACE     ;;^ENG("SP")~^ENG("SP",0)~Eng Space~6928~ENT^ENSP2

EQT       ;;^ENG(6914)~^ENG(6914,0)~Equipment Inv.~6914~DS^ENEQ1