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 ---[H[J[2J[HECTDIR 2005 printed Sep 23, 2025@19:38:20 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
