- ENCTUTL ;(WASH ISC)/RGY-Bar Code Task Handler ;1-19-93
- ;;7.0;ENGINEERING;;Aug 17, 1993
- ;Copy of PRCTUTL ;DH-WASH ISC
- PRO ;Enter/edit barcode program
- S DIC="^PRCT(446.4,",DIC(0)="QEAML" D ^DIC G:+Y<0 Q1 S DIE=DIC,DR="[ENCT PROGRAM ENTER/EDIT]",DA=+Y D ^DIE
- Q1 K DIC,DIE,DA,DR Q
- PARAM ;Edit barcode parameters
- S DIC="^PRCT(446.4,",DIC(0)="QEAM" D ^DIC G:+Y<0 Q2 S DIE=DIC,DR="[ENCT PARAMETER ENTER/EDIT]",DA=+Y D ^DIE
- Q2 K DIC,DIE,DA,DR Q
- DATA ;Enter/Edit/View barcode data
- S DIC="^PRCT(446.4,",DIC(0)="QEAM" D ^DIC G:+Y<0 Q3 S DIE=DIC,DR="[ENCT DATA ENTER/EDIT/VIEW]",DA=+Y D ^DIE
- Q3 K DIC,DIE,DA,DR Q
- IDENT ; Called by input transform for IDENTIFIER (446.4,.02)
- I $D(^PRCT(446.4,"C",X)),$O(^(X,""))'=DA S X=$O(^("")) W !,"This IDENTIFIER alread exists for ",$S($D(^PRCT(446.4,+X,0)):$P(^(0),"^"),1:X)," !" K X Q
- I '$D(^DIC(9.4,"C",$E(X,1,$L(X)-2))) W !,"The PACKAGE NAME SPACE '",$E(X,1,$L(X)-2),"' does not exist !" K X
- Q
- RTN ; Called by input transform for 446.4,.03 and 446.4,.04
- S:X'["-" X="-"_X I $D(^DD("OS"))#2,$D(^("OS",^DD("OS"),18)) S ENCT1=X,X=$P(ENCT1,"-",2) X ^(18) S X=ENCT1 K ENCT1 I '$T W " ... routine does not exist" K X
- Q
- PROG ; Called by the input transform for 446.52,1
- I $S('$D(DUZ)#2:1,'$D(^VA(200,DUZ,0)):1,1:0) K X W " ... Sorry, Your DUZ (user value) is not defined" Q
- I '$D(DUZ(0))#2 K X W " ... Sorry, your FileMan access is not defined" Q
- I DUZ(0)'="@" K X W " ... Sorry, only programmers can use this field" Q
- D ^DIM W:'$D(X) " ... MUMPS code has an error" Q
- INQ ;Call to inquire on FILEMAN report
- S DIC="^PRCT(446.5,",DIC(0)="QEAM",DR="0:2" D ^DIC G:Y<0 Q4 S DA=+Y D EN^DIQ G INQ
- Q4 K DIC,DA Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENCTUTL 1667 printed Feb 18, 2025@23:18:44 Page 2
- ENCTUTL ;(WASH ISC)/RGY-Bar Code Task Handler ;1-19-93
- +1 ;;7.0;ENGINEERING;;Aug 17, 1993
- +2 ;Copy of PRCTUTL ;DH-WASH ISC
- PRO ;Enter/edit barcode program
- +1 SET DIC="^PRCT(446.4,"
- SET DIC(0)="QEAML"
- DO ^DIC
- if +Y<0
- GOTO Q1
- SET DIE=DIC
- SET DR="[ENCT PROGRAM ENTER/EDIT]"
- SET DA=+Y
- DO ^DIE
- Q1 KILL DIC,DIE,DA,DR
- QUIT
- PARAM ;Edit barcode parameters
- +1 SET DIC="^PRCT(446.4,"
- SET DIC(0)="QEAM"
- DO ^DIC
- if +Y<0
- GOTO Q2
- SET DIE=DIC
- SET DR="[ENCT PARAMETER ENTER/EDIT]"
- SET DA=+Y
- DO ^DIE
- Q2 KILL DIC,DIE,DA,DR
- QUIT
- DATA ;Enter/Edit/View barcode data
- +1 SET DIC="^PRCT(446.4,"
- SET DIC(0)="QEAM"
- DO ^DIC
- if +Y<0
- GOTO Q3
- SET DIE=DIC
- SET DR="[ENCT DATA ENTER/EDIT/VIEW]"
- SET DA=+Y
- DO ^DIE
- Q3 KILL DIC,DIE,DA,DR
- QUIT
- IDENT ; Called by input transform for IDENTIFIER (446.4,.02)
- +1 IF $DATA(^PRCT(446.4,"C",X))
- IF $ORDER(^(X,""))'=DA
- SET X=$ORDER(^(""))
- WRITE !,"This IDENTIFIER alread exists for ",$SELECT($DATA(^PRCT(446.4,+X,0)):$PIECE(^(0),"^"),1:X)," !"
- KILL X
- QUIT
- +2 IF '$DATA(^DIC(9.4,"C",$EXTRACT(X,1,$LENGTH(X)-2)))
- WRITE !,"The PACKAGE NAME SPACE '",$EXTRACT(X,1,$LENGTH(X)-2),"' does not exist !"
- KILL X
- +3 QUIT
- RTN ; Called by input transform for 446.4,.03 and 446.4,.04
- +1 if X'["-"
- SET X="-"_X
- IF $DATA(^DD("OS"))#2
- IF $DATA(^("OS",^DD("OS"),18))
- SET ENCT1=X
- SET X=$PIECE(ENCT1,"-",2)
- XECUTE ^(18)
- SET X=ENCT1
- KILL ENCT1
- IF '$TEST
- WRITE " ... routine does not exist"
- KILL X
- +2 QUIT
- PROG ; Called by the input transform for 446.52,1
- +1 IF $SELECT('$DATA(DUZ)#2:1,'$DATA(^VA(200,DUZ,0)):1,1:0)
- KILL X
- WRITE " ... Sorry, Your DUZ (user value) is not defined"
- QUIT
- +2 IF '$DATA(DUZ(0))#2
- KILL X
- WRITE " ... Sorry, your FileMan access is not defined"
- QUIT
- +3 IF DUZ(0)'="@"
- KILL X
- WRITE " ... Sorry, only programmers can use this field"
- QUIT
- +4 DO ^DIM
- if '$DATA(X)
- WRITE " ... MUMPS code has an error"
- QUIT
- INQ ;Call to inquire on FILEMAN report
- +1 SET DIC="^PRCT(446.5,"
- SET DIC(0)="QEAM"
- SET DR="0:2"
- DO ^DIC
- if Y<0
- GOTO Q4
- SET DA=+Y
- DO EN^DIQ
- GOTO INQ
- Q4 KILL DIC,DA
- QUIT