Changeset 623 for WorldVistAEHR/trunk/r/ENGINEERING-EN
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- Location:
- WorldVistAEHR/trunk/r/ENGINEERING-EN
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ENGINEERING-EN/ENEQ4.m
r613 r623 1 ENEQ4 ;WIRMFO/SAB-PURGE EQUIPMENT INV FILE ;12/28/07 13:54 2 ;;7.0;ENGINEERING;**40,87**;Aug 17, 1993;Build 16 3 ; 4 DEL ;Delete Equipment Record entry 5 S ENEDNX=$D(^XUSEC("ENEDNX",DUZ)) 6 W !!,"This option completely deletes a specific equipment record. If" 7 W !,"you would rather move equipment records to an archive media, then" 8 W !,"exit this option and use the Engineering Archive Module instead." 9 DELSEQ ; select equipment record for deletion 10 W ! 11 D GETEQ^ENUTL G:Y'>0 DELX 12 S ENDA=+Y 13 F ENI=0,1,2,3 S ENY(ENI)=$G(^ENG(6914,ENDA,ENI)) 14 ; 15 ; display equipment data 16 W @IOF 17 W !,"ENTRY #: ",ENDA 18 W !!,?2,"MFGR EQUIP NAME: ",$P(ENY(0),U,2) 19 W !,?2,"EQUIP CATEGORY: ",$$GET1^DIQ(6914,ENDA,6) 20 W !,?2,"CSN: ",$$GET1^DIQ(6914,ENDA,18) 21 S ENX=$$GET1^DIQ(6914,ENDA,"18:2") I ENX]"" W " (",ENX,")" 22 W !!,?2,"MANUFACTURER: ",$$GET1^DIQ(6914,ENDA,1) 23 W !,?2,"MODEL: ",$P(ENY(1),U,2),?42,"SERIAL #: ",$P(ENY(1),U,3) 24 W !!,?2,"CMR: ",$$GET1^DIQ(6914,ENDA,19) 25 W ?42,"USE STATUS: ",$$GET1^DIQ(6914,ENDA,20) 26 W !,?2,"ACQUISITION DATE: ",$$FMTE^XLFDT($P(ENY(2),U,4)) 27 W ?34,"LE: ",$P(ENY(2),U,6) 28 W ?42,"DISPOSITION DATE: ",$$FMTE^XLFDT($P(ENY(3),U,11)),! 29 ; 30 ; validate selection 31 K ENV 32 S ENX=$$CHKFA^ENFAUTL(ENDA) 33 I +ENX S ENV(1)="It is currently reported to Fixed Assets in Austin." 34 E I $P(ENX,U,2)]"" S ENV(2)="It was previously reported to Fixed Assets in Austin." 35 I $P(ENY(0),U,4)="NX",'ENEDNX S ENV(3)="Security key ENEDNX is required to delete NX equipment." 36 I $P(ENY(3),U,1)=1 S ENV(4)="USE STATUS is IN USE." 37 I $P(ENY(3),U,11)="" S ENV(5)="DISPOSITION DATE is blank." 38 I $D(^ENG(6916.3,"B",ENDA)) S ENV(6)="It is linked to an IT Assignment record." 39 I $D(ENV) D G DELSEQ 40 . W $C(7),!,"This equipment entry can not be deleted because:" 41 . S ENI=0 F S ENI=$O(ENV(ENI)) Q:'ENI W !,?2,ENV(ENI) 42 ; 43 ; confirm deletion 44 S DIR(0)="Y",DIR("A")="Delete this entry" 45 D ^DIR K DIR G:$D(DIRUT) DELX I 'Y G DELSEQ 46 ; 47 ; first close any open work orders 48 S ENTXT(1)="Automatically closed when equipment record was deleted." 49 S DA=0 F S DA=$O(^ENG(6920,"G",ENDA,DA)) Q:'DA I $P($G(^ENG(6920,DA,5)),U,2)="" D 50 . D WP^DIE(6920,DA_",",40,"A","ENTXT") 51 . S DIE="^ENG(6920,",DR="36///T;32///^S X=""COMPLETED""" 52 . D ^DIE 53 K DIE,DR,ENTXT 54 ; then delete equipment 55 S DIK="^ENG(6914,",DA=ENDA D ^DIK K DIK 56 W !,"Equipment entry # ",ENDA," was deleted." 57 ; 58 G DELSEQ 59 ; 60 DELX ; delete equipment record exit 61 K DA,DIC,DIE,DIK,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,Y 62 K END,ENDA,ENEDNX,ENI,ENV,ENWO,ENX,ENY 63 Q 64 ; 65 ;ENEQ4 1 ENEQ4 ;WIRMFO/SAB-PURGE EQUIPMENT INV FILE ;2.25.97 2 ;;7.0;ENGINEERING;**40**;Aug 17, 1993 3 ; 4 DEL ;Delete Equipment Record entry 5 S ENEDNX=$D(^XUSEC("ENEDNX",DUZ)) 6 W !!,"This option completely deletes a specific equipment record. If" 7 W !,"you would rather move equipment records to an archive media, then" 8 W !,"exit this option and use the Engineering Archive Module instead." 9 DELSEQ ; select equipment record for deletion 10 W ! 11 D GETEQ^ENUTL G:Y'>0 DELX 12 S ENDA=+Y 13 F ENI=0,1,2,3 S ENY(ENI)=$G(^ENG(6914,ENDA,ENI)) 14 ; 15 ; display equipment data 16 W @IOF 17 W !,"ENTRY #: ",ENDA 18 W !!,?2,"MFGR EQUIP NAME: ",$P(ENY(0),U,2) 19 W !,?2,"EQUIP CATEGORY: ",$$GET1^DIQ(6914,ENDA,6) 20 W !,?2,"CSN: ",$$GET1^DIQ(6914,ENDA,18) 21 S ENX=$$GET1^DIQ(6914,ENDA,"18:2") I ENX]"" W " (",ENX,")" 22 W !!,?2,"MANUFACTURER: ",$$GET1^DIQ(6914,ENDA,1) 23 W !,?2,"MODEL: ",$P(ENY(1),U,2),?42,"SERIAL #: ",$P(ENY(1),U,3) 24 W !!,?2,"CMR: ",$$GET1^DIQ(6914,ENDA,19) 25 W ?42,"USE STATUS: ",$$GET1^DIQ(6914,ENDA,20) 26 W !,?2,"ACQUISITION DATE: ",$$FMTE^XLFDT($P(ENY(2),U,4)) 27 W ?34,"LE: ",$P(ENY(2),U,6) 28 W ?42,"DISPOSITION DATE: ",$$FMTE^XLFDT($P(ENY(3),U,11)),! 29 ; 30 ; validate selection 31 K ENV 32 S ENX=$$CHKFA^ENFAUTL(ENDA) 33 I +ENX S ENV(1)="It is currently reported to Fixed Assets in Austin." 34 E I $P(ENX,U,2)]"" S ENV(2)="It was previously reported to Fixed Assets in Austin." 35 I $P(ENY(0),U,4)="NX",'ENEDNX S ENV(3)="Security key ENEDNX is required to delete NX equipment." 36 I $P(ENY(3),U,1)=1 S ENV(4)="USE STATUS is IN USE." 37 I $P(ENY(3),U,11)="" S ENV(5)="DISPOSITION DATE is blank." 38 I $D(ENV) D G DELSEQ 39 . W $C(7),!,"This equipment entry can not be deleted because:" 40 . S ENI=0 F S ENI=$O(ENV(ENI)) Q:'ENI W !,?2,ENV(ENI) 41 ; 42 ; confirm deletion 43 S DIR(0)="Y",DIR("A")="Delete this entry" 44 D ^DIR K DIR G:$D(DIRUT) DELX I 'Y G DELSEQ 45 ; 46 ; first close any open work orders 47 S ENTXT(1)="Automatically closed when equipment record was deleted." 48 S DA=0 F S DA=$O(^ENG(6920,"G",ENDA,DA)) Q:'DA I $P($G(^ENG(6920,DA,5)),U,2)="" D 49 . D WP^DIE(6920,DA_",",40,"A","ENTXT") 50 . S DIE="^ENG(6920,",DR="36///T;32///^S X=""COMPLETED""" 51 . D ^DIE 52 K DIE,DR,ENTXT 53 ; then delete equipment 54 S DIK="^ENG(6914,",DA=ENDA D ^DIK K DIK 55 W !,"Equipment entry # ",ENDA," was deleted." 56 ; 57 G DELSEQ 58 ; 59 DELX ; delete equipment record exit 60 K DA,DIC,DIE,DIK,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,Y 61 K END,ENDA,ENEDNX,ENI,ENV,ENWO,ENX,ENY 62 Q 63 ; 64 ;ENEQ4 -
WorldVistAEHR/trunk/r/ENGINEERING-EN/ENPLS2.m
r613 r623 1 ENPLS2 ;WISC/SAB - Select Items from List ;12/4/07 13:24 2 ;;7.0;ENGINEERING;**23,87**;Aug 17, 1993;Build 16 3 EN ; entry point 4 ; input global 5 ; ^TMP($J,"SCR)=number of entries in list^screen title 6 ; ^TMP($J,"SCR",0)=col 1 x pos;col 1 hdr^...^col n x pos;col n hdr 7 ; ^TMP($J,"SCR",id)=col 1 value^col 2 value^...^col n value 8 ; output 9 ; optional ENACL( selected items 10 ; 11 ; initialize variables 12 N ENI,ENID,ENF,ENI,ENS,ENX,ENY 13 K ENACL 14 S $P(ENF("DASH"),"-",80)="" 15 ; get screen info 16 S ENX=^TMP($J,"SCR") 17 S ENF("IDM")=$P(ENX,U) 18 S ENF("HD")=$P(ENX,U,2) 19 ; get column info 20 S ENX=^TMP($J,"SCR",0),ENF("CM")=0 21 F ENI=1:1 S ENY=$P(ENX,U,ENI) Q:ENY="" D 22 . S ENF("CM")=ENF("CM")+1 23 . S ENF("C"_ENI,"X")=$P(ENY,";",1) 24 . S ENF("C"_ENI,"L")=$P(ENY,";",2) 25 . S ENF("C"_ENI,"HD")=$P(ENY,";",3) 26 S ENF("SM")=(ENF("IDM")-1)\15+1 27 S ENF("S")=1 28 BLD ; build screen 29 K ENS 30 S ENS("IDL")=1+(ENF("S")-1*15) 31 S ENS("IDM")=$S(15+(ENF("S")-1*15)>ENF("IDM"):ENF("IDM"),1:15+(ENF("S")-1*15)) 32 ; display screen 33 D SHD 34 F ENID=ENS("IDL"):1:ENS("IDM") D W ! 35 . S ENX=^TMP($J,"SCR",ENID) 36 . W $J(ENID,3) 37 . F ENI=1:1:ENF("CM") W ?ENF("C"_ENI,"X"),$P(ENX,U,ENI) 38 ACT ; prompt for selection 39 W ! 40 S DIR("A")="Enter a list or range to select (1-"_ENF("IDM")_"): "_$S(ENF("S")<ENF("SM"):"Next Screen",1:"Quit")_"//" 41 S DIR(0)="LOA^1:"_ENF("IDM") 42 D ^DIR K DIR G:$D(DTOUT)!$D(DUOUT) EXIT 43 I X="",ENF("S")<ENF("SM") S ENF("S")=ENF("S")+1 G BLD 44 K ENACL S ENI="" F S ENI=$O(Y(ENI)) Q:ENI="" S ENACL(ENI)=Y(ENI) 45 EXIT ; 46 W:'$G(ENGNOFF) @IOF 47 K DX,DY 48 Q 49 EN2(ENGNOFF) ;Entry point to suppress Form Feed at end 50 G EN 51 SHD ; Screen Header 52 W @IOF 53 W ENF("HD"),?65,"Screen ",ENF("S")," of ",ENF("SM"),!! 54 W "ID#" 55 F ENI=1:1:ENF("CM") W ?ENF("C"_ENI,"X"),ENF("C"_ENI,"HD") 56 W ! 57 W "---" 58 F ENI=1:1:ENF("CM") W ?ENF("C"_ENI,"X"),$E(ENF("DASH"),1,ENF("C"_ENI,"L")) 59 W ! 60 Q 61 PYLIST ; Progam and Year list of project applications 62 N ENACL,ENC,ENDA,ENI,ENIDX,ENJ,ENK,ENPN,ENPR,ENY,ENY0,ENYR 63 K ^TMP($J,"R") 64 S DIR(0)="S^MA:MAJOR;MI:MINOR;MM:MINOR MISC;NR:NRM" 65 S DIR("?")="Enter program that listed projects must match." 66 D ^DIR K DIR Q:$D(DIRUT) 67 S ENPR=Y 68 S DIR(0)="N^1993:2099:0",DIR("A")="YEAR" 69 S DIR("?",1)="Enter a 4-digit year that listed projects must have as" 70 S DIR("?")="the A/E or Construction funding year." 71 S DIR("B")=$E(17000000+DT,1,4)+$S($E(DT,4,7)>0600:2,1:1) 72 D ^DIR K DIR Q:$D(DIRUT) 73 S ENYR=Y 74 F ENIDX="F","G" D 75 . S ENDA=0 F S ENDA=$O(^ENG("PROJ",ENIDX,ENYR,ENDA)) Q:'ENDA D 76 . . S ENY0=$G(^ENG("PROJ",ENDA,0)) Q:$P(ENY0,U)=""!($P(ENY0,U,6)'=ENPR) 77 . . S ^TMP($J,"R",$P(ENY0,U))=$P(ENY0,U)_U_$P(ENY0,U,3)_U_ENDA 78 I '$D(^TMP($J,"R")) W !!,"No Projects matched selection criteria!",! Q 79 S ENI=0,ENPN="" F S ENPN=$O(^TMP($J,"R",ENPN)) Q:ENPN="" S ENI=ENI+1,^TMP($J,"SCR",ENI)=^(ENPN) 80 S ^TMP($J,"SCR")=ENI_U_"PROGRAM ("_ENPR_") PROJECTS WITH FUNDING YEAR "_ENYR 81 S ^TMP($J,"SCR",0)="5;11;PROJECT #^19;50;TITLE" 82 D ^ENPLS2 83 ; save selected projects (if any) 84 S ENC=0,ENJ="" F S ENJ=$O(ENACL(ENJ)) Q:ENJ="" D 85 . F ENK=1:1 S ENI=$P(ENACL(ENJ),",",ENK) Q:ENI="" D 86 . . S ENY=^TMP($J,"SCR",ENI),^TMP($J,"L",$P(ENY,U))=$P(ENY,U,3),ENC=ENC+1 87 S:ENC ^TMP($J,"L")=ENC_$S(ENTY="F":U_ENFY,1:"") 88 K ^TMP($J,"R"),^TMP($J,"SCR") 89 Q 90 ;ENPLS2 1 ENPLS2 ;WISC/SAB - Select Items from List ;7/21/95 2 ;;7.0;ENGINEERING;**23**;Aug 17, 1993 3 EN ; entry point 4 ; input global 5 ; ^TMP($J,"SCR)=number of entries in list^screen title 6 ; ^TMP($J,"SCR",0)=col 1 x pos;col 1 hdr^...^col n x pos;col n hdr 7 ; ^TMP($J,"SCR",id)=col 1 value^col 2 value^...^col n value 8 ; output 9 ; optional ENACL( selected items 10 ; 11 ; initialize variables 12 N ENI,ENID,ENF,ENI,ENS,ENX,ENY 13 K ENACL 14 S $P(ENF("DASH"),"-",80)="" 15 ; get screen info 16 S ENX=^TMP($J,"SCR") 17 S ENF("IDM")=$P(ENX,U) 18 S ENF("HD")=$P(ENX,U,2) 19 ; get column info 20 S ENX=^TMP($J,"SCR",0),ENF("CM")=0 21 F ENI=1:1 S ENY=$P(ENX,U,ENI) Q:ENY="" D 22 . S ENF("CM")=ENF("CM")+1 23 . S ENF("C"_ENI,"X")=$P(ENY,";",1) 24 . S ENF("C"_ENI,"L")=$P(ENY,";",2) 25 . S ENF("C"_ENI,"HD")=$P(ENY,";",3) 26 S ENF("SM")=(ENF("IDM")-1)\15+1 27 S ENF("S")=1 28 BLD ; build screen 29 K ENS 30 S ENS("IDL")=1+(ENF("S")-1*15) 31 S ENS("IDM")=$S(15+(ENF("S")-1*15)>ENF("IDM"):ENF("IDM"),1:15+(ENF("S")-1*15)) 32 ; display screen 33 D SHD 34 F ENID=ENS("IDL"):1:ENS("IDM") D W ! 35 . S ENX=^TMP($J,"SCR",ENID) 36 . W $J(ENID,3) 37 . F ENI=1:1:ENF("CM") W ?ENF("C"_ENI,"X"),$P(ENX,U,ENI) 38 ACT ; prompt for selection 39 W ! 40 S DIR("A")="Enter a list or range to select (1-"_ENF("IDM")_"): "_$S(ENF("S")<ENF("SM"):"Next Screen",1:"Quit")_"//" 41 S DIR(0)="LOA^1:"_ENF("IDM") 42 D ^DIR K DIR G:$D(DTOUT)!$D(DUOUT) EXIT 43 I X="",ENF("S")<ENF("SM") S ENF("S")=ENF("S")+1 G BLD 44 K ENACL S ENI="" F S ENI=$O(Y(ENI)) Q:ENI="" S ENACL(ENI)=Y(ENI) 45 EXIT ; 46 W @IOF 47 K DX,DY 48 Q 49 SHD ; Screen Header 50 W @IOF 51 W ENF("HD"),?65,"Screen ",ENF("S")," of ",ENF("SM"),!! 52 W "ID#" 53 F ENI=1:1:ENF("CM") W ?ENF("C"_ENI,"X"),ENF("C"_ENI,"HD") 54 W ! 55 W "---" 56 F ENI=1:1:ENF("CM") W ?ENF("C"_ENI,"X"),$E(ENF("DASH"),1,ENF("C"_ENI,"L")) 57 W ! 58 Q 59 PYLIST ; Progam and Year list of project applications 60 N ENACL,ENC,ENDA,ENI,ENIDX,ENJ,ENK,ENPN,ENPR,ENY,ENY0,ENYR 61 K ^TMP($J,"R") 62 S DIR(0)="S^MA:MAJOR;MI:MINOR;MM:MINOR MISC;NR:NRM" 63 S DIR("?")="Enter program that listed projects must match." 64 D ^DIR K DIR Q:$D(DIRUT) 65 S ENPR=Y 66 S DIR(0)="N^1993:2099:0",DIR("A")="YEAR" 67 S DIR("?",1)="Enter a 4-digit year that listed projects must have as" 68 S DIR("?")="the A/E or Construction funding year." 69 S DIR("B")=$E(17000000+DT,1,4)+$S($E(DT,4,7)>0600:2,1:1) 70 D ^DIR K DIR Q:$D(DIRUT) 71 S ENYR=Y 72 F ENIDX="F","G" D 73 . S ENDA=0 F S ENDA=$O(^ENG("PROJ",ENIDX,ENYR,ENDA)) Q:'ENDA D 74 . . S ENY0=$G(^ENG("PROJ",ENDA,0)) Q:$P(ENY0,U)=""!($P(ENY0,U,6)'=ENPR) 75 . . S ^TMP($J,"R",$P(ENY0,U))=$P(ENY0,U)_U_$P(ENY0,U,3)_U_ENDA 76 I '$D(^TMP($J,"R")) W !!,"No Projects matched selection criteria!",! Q 77 S ENI=0,ENPN="" F S ENPN=$O(^TMP($J,"R",ENPN)) Q:ENPN="" S ENI=ENI+1,^TMP($J,"SCR",ENI)=^(ENPN) 78 S ^TMP($J,"SCR")=ENI_U_"PROGRAM ("_ENPR_") PROJECTS WITH FUNDING YEAR "_ENYR 79 S ^TMP($J,"SCR",0)="5;11;PROJECT #^19;50;TITLE" 80 D ^ENPLS2 81 ; save selected projects (if any) 82 S ENC=0,ENJ="" F S ENJ=$O(ENACL(ENJ)) Q:ENJ="" D 83 . F ENK=1:1 S ENI=$P(ENACL(ENJ),",",ENK) Q:ENI="" D 84 . . S ENY=^TMP($J,"SCR",ENI),^TMP($J,"L",$P(ENY,U))=$P(ENY,U,3),ENC=ENC+1 85 S:ENC ^TMP($J,"L")=ENC_$S(ENTY="F":U_ENFY,1:"") 86 K ^TMP($J,"R"),^TMP($J,"SCR") 87 Q 88 ;ENPLS2
Note:
See TracChangeset
for help on using the changeset viewer.
