- ENEQPMP1 ;(WIRMFO)/DH/SAB-Maintain PMI Parameters ;7.29.97
- ;;7.0;ENGINEERING;**35,43**;Aug 17, 1993
- PMSD ; Display device PM schedule
- N DIC,DIE,DA,DR,X,I,J,I1,TAG,K
- W @IOF,!! S DIC(0)="AEQM",(DIC,DIE)="^ENG(6914," D ^DIC G:Y'>0 EXIT S DA=+Y D DINV^ENEQPMP3 G:'$D(ENXP) PMSD G EXIT
- ;
- DTD ; Display Equipment Category PM data
- N DIC,DIE,DA,DR,X,I,J,I1,TAG,K
- S DIC(0)="AEQM" D DTL G:ENDTYP'>0 EXIT D DDT^ENEQPMP3 W @IOF
- Q
- ;
- DTE ; Edit Equipment Category PM data
- I '$D(^XUSEC("ENEDPM")) W !!,"Sorry, you need Security Key 'ENEDPM'." D HLD G EXIT
- N DIC,DIE,DA,DR,I,J,X,I1,TAG,K
- S DIC(0)="AEQML",DLAYGO=6911 D DTL K DLAYGO G:ENDTYP'>0 EXIT
- L +^ENG(6911,ENDTYP):1 I '$T W !!,*7,"Someone else is editing this record." G EXIT
- S DA=ENDTYP,DR="[ENEQPMP]"
- DTE1 D DDT^ENEQPMP3,^DIE
- L -^ENG(6911,ENDTYP)
- G:'$D(DA) DTE
- DTE2 W !,"Are you finished with this Equipment Category" S %=1 D YN^DICN G:%=2 DTE1 G:%<0 DTE I %=0 W !,"Please enter 'YES' or 'NO'." G DTE2
- S ENDVTYP=$P($G(^ENG(6911,ENDTYP,0)),U)
- DTE3 I $O(^ENG(6911,ENDTYP,4,0)) W !,"Do you wish to assign this PM schedule to ALL existing equipment records",!,"in the category of "_ENDVTYP
- E W !,"Do you want to delete existing PM schedules (if any) from equipment records",!,"in the category of "_ENDVTYP
- S %=2 D YN^DICN S TAG=$S(%=1:"DTE5",%=2:"DTE",1:"DTE4") G @TAG
- DTE4 D DTEH G DTE3
- DTE5 W !,"Do you wish to confirm each transaction" S %=2 D YN^DICN G:%<1 DTEH1 S ENCONF=$S(%=1:1,1:0)
- F DA=0:0 S DA=$O(^ENG(6914,"G",ENDTYP,DA)) Q:DA'>0 W !,DA W:$D(^ENG(6914,DA,3)) ?10,$P(^(3),U,6) D DTE51
- D HLD G DTE
- DTE51 I 'ENCONF D PMSE3^ENEQPMP Q
- W " OK" S %=1 D YN^DICN D:%=1 PMSE3^ENEQPMP
- Q
- ;
- DTL W @IOF,!! S (DIC,DIE)="^ENG(6911," D ^DIC S ENDTYP=+Y
- Q
- ;
- DTEH W !!,"'YES' will cause the system to immediately find every equipment record of",!,"type "_ENDVTYP_" and assign each of them the PM schedule just entered."
- W !,"The ENTRY NUMBER of each affected equipment record will be displayed at",!,"your terminal, but you will not be asked to confirm the transaction unless",!,"you say that you want to."
- W !,"Once this process has begun, it should not be interrupted."
- Q
- DTEH1 W !!,"You should enter 'YES' if you want to apply the revised schedule to some",!,ENDVTYP,"'s but not others."
- W !,"Enter 'NO' if you want the revised schedule applied to all equipment of",!,"type ",ENDVTYP,"."
- G DTE5
- SKPCK ;SKP MNTHS = ENA ;Called by FileMan Input X-form
- S ENA=X,ENB=$P(ENA,"-",2),ENA=$P(ENA,"-",1)
- I ENA'="JUN",ENA'="SEP",ENA'="MAY",ENA'="OCT",ENA'="APR",ENA'="AUG",ENA'="JUL",ENA'="NOV",ENA'="MAR",ENA'="DEC",ENA'="FEB",ENA'="JAN" S ENA="ERR"
- I ENB'="JUN",ENB'="SEP",ENB'="MAY",ENB'="OCT",ENB'="APR",ENB'="AUG",ENB'="JUL",ENB'="NOV",ENB'="MAR",ENB'="DEC",ENB'="FEB",ENB'="JAN" S ENA="ERR"
- I ENA="ERR"!(ENB="ERR") D EN^DDIOL("You seem to have an invalid entry for 'SKIP MONTHS'. Valid abbreviations are") D EN^DDIOL("JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV, and DEC. Please re-edit.")
- Q
- HLD I $E(IOST,1,2)="C-" R !,"Press <RETURN> to continue...",X:DTIME
- Q
- EXIT K ENDTYP,ENDVTYP,ENA,ENB,ENCRIT,ENXP,ENC,ENCONF,ENX
- Q
- ;
- RT ;Reassign a Technicians PMI Responsibilities
- ;
- RTASK ; ask user
- W !
- S DIC=6929,DIC(0)="AQEM",DIC("A")="Replace this TECHNICIAN: "
- D ^DIC K DIC G:Y'>0 RTEX S ENTEC("O")=+Y,ENTECN("O")=$P(Y,U,2)
- ;
- S DIC=6929,DIC(0)="AQEM",DIC("A")="With this TECHNICIAN: "
- D ^DIC K DIC G:Y'>0 RTEX S ENTEC("N")=+Y,ENTECN("N")=$P(Y,U,2)
- ;
- S DIR(0)="S^0:ONE RESPONSIBLE SHOP;1:ALL RESPONSIBLE SHOPS"
- S DIR("A")="For PM schedules by",DIR("B")="ALL"
- D ^DIR K DIR G:$D(DIRUT) RTEX S ENSHKEY("ALL")=Y
- ;
- I 'ENSHKEY("ALL") D I ENSHKEY'>0 G RTEX
- . S DIC=6922,DIC(0)="AQEM" D ^DIC K DIC S ENSHKEY=+Y,ENSHOP=$P(Y,U,2)
- ;
- S DIR(0)="Y",DIR("A")="Do you want to individually edit each entry"
- S DIR("B")="NO"
- S DIR("?",1)="If YES is entered here, the system will pause after each entry"
- S DIR("?",2)="for which TECHNICIAN "_ENTECN("O")_" has been changed"
- S DIR("?",3)="and allow you to edit the TECHNICIAN field."
- S DIR("?",4)=" "
- S DIR("?")="Enter YES or NO"
- D ^DIR K DIR G:$D(DTOUT) RTEX S ENEDTEC=Y
- ;
- W !!,"All occurrences of TECHNICIAN in both the EQUIPMENT CATEGORY and"
- W !,"EQUIPMENT INV. preventive maintenance schedules will be changed"
- W !,"from ",ENTECN("O")," to ",ENTECN("N"),"."
- W !,"This change will be made for "
- I ENSHKEY("ALL") W "the PM schedules of ALL responsible shops."
- E W "only the PM schedules of the ",ENSHOP," shop."
- I ENEDTEC W !,"You will be able to individually edit the TECHNICAN."
- W ! S DIR(0)="Y",DIR("A")="OK to Proceed"
- D ^DIR K DIR G:'Y!$D(DIRUT) RTEX
- ;
- RTDO S END=0
- W !!,"Updating EQUIPMENT CATEGORY file"
- I ENEDTEC S DIR(0)="E" D ^DIR K DIR I $D(DIRUT) S END=1 G RTEX
- S (ENC,ENT)=0
- S ENDA=0 F S ENDA=$O(^ENG(6911,ENDA)) Q:'ENDA D Q:END
- . S ENI=0 F S ENI=$O(^ENG(6911,ENDA,4,ENI)) Q:'ENI D Q:END
- . . S ENT=ENT+1
- . . I 'ENEDTEC W:'(ENT#50) "."
- . . S ENY=$G(^ENG(6911,ENDA,4,ENI,0))
- . . S ENRS=$P(ENY,U)
- . . I 'ENSHKEY("ALL"),ENRS'=ENSHKEY Q
- . . I $P(ENY,U,2)'=ENTEC("O") Q
- . . ;W !," ENDA: ",ENDA,?12,"ENI: ",ENI,?20,ENY
- . . S $P(^ENG(6911,ENDA,4,ENI,0),U,2)=ENTEC("N")
- . . S ENC=ENC+1
- . . I ENEDTEC D
- . . . S ENDTYP=ENDA,ENNOHLD=1 D DDT^ENEQPMP3
- . . . W !!,"For the ",$P($G(^DIC(6922,ENRS,0)),U)," SHOP PM Schedule:"
- . . . S DIE="^ENG(6911,"_ENDA_",4,",DA(1)=ENDA,DA=ENI,DR="1"
- . . . D ^DIE K DA S:$D(Y) END=1
- W !," ",ENC,$S(ENC=1:" entry was",1:" entries were")," changed."
- G:END RTEX
- ;
- W !!,"Updating EQUIPMENT INV. file"
- I ENEDTEC S DIR(0)="E" D ^DIR K DIR I $D(DIRUT) S END=1 G RTEX
- S (ENC,ENT)=0
- I 'ENSHKEY("ALL") S ENRS=ENSHKEY D RTSHOP
- I ENSHKEY("ALL") S ENRS=0 F S ENRS=$O(^ENG(6914,"AB",ENRS)) Q:'ENRS D RTSHOP Q:END
- W !," ",ENC,$S(ENC=1:" entry was",1:" entries were")," changed."
- ;
- RTEX ; reassign tech exit
- K DA,DIC,DIE,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,Y
- K ENC,END,ENDA,ENDTYP,ENDVTYP,ENEDTEC,ENI,ENNOHLD,ENRS
- K ENSHKEY,ENSHOP,ENT,ENTEC,ENTECN,ENX,ENY
- Q
- ;
- RTSHOP ; update all entries for responsible shop ENRS
- S ENDA=0 F S ENDA=$O(^ENG(6914,"AB",ENRS,ENDA)) Q:'ENDA D Q:END
- . S ENT=ENT+1
- . I 'ENEDTEC W:'(ENT#50) "."
- . S ENI=$O(^ENG(6914,"AB",ENRS,ENDA,0))
- . S ENY=$G(^ENG(6914,ENDA,4,ENI,0))
- . I $P(ENY,U,2)'=ENTEC("O") Q
- . ;W !," ENDA: ",ENDA,?12,"ENI: ",ENI,?20,ENY
- . S $P(^ENG(6914,ENDA,4,ENI,0),U,2)=ENTEC("N")
- . S ENC=ENC+1
- . I ENEDTEC D
- . . S DA=ENDA,ENNOHLD=1 D DINV^ENEQPMP3
- . . W !!,"For the ",$P($G(^DIC(6922,ENRS,0)),U)," SHOP PM Schedule:"
- . . S DIE="^ENG(6914,"_ENDA_",4,",DA(1)=ENDA,DA=ENI,DR="1"
- . . D ^DIE K DA S:$D(Y) END=1
- Q
- ;
- ;ENEQPMP1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQPMP1 6713 printed Feb 18, 2025@23:19:07 Page 2
- ENEQPMP1 ;(WIRMFO)/DH/SAB-Maintain PMI Parameters ;7.29.97
- +1 ;;7.0;ENGINEERING;**35,43**;Aug 17, 1993
- PMSD ; Display device PM schedule
- +1 NEW DIC,DIE,DA,DR,X,I,J,I1,TAG,K
- +2 WRITE @IOF,!!
- SET DIC(0)="AEQM"
- SET (DIC,DIE)="^ENG(6914,"
- DO ^DIC
- if Y'>0
- GOTO EXIT
- SET DA=+Y
- DO DINV^ENEQPMP3
- if '$DATA(ENXP)
- GOTO PMSD
- GOTO EXIT
- +3 ;
- DTD ; Display Equipment Category PM data
- +1 NEW DIC,DIE,DA,DR,X,I,J,I1,TAG,K
- +2 SET DIC(0)="AEQM"
- DO DTL
- if ENDTYP'>0
- GOTO EXIT
- DO DDT^ENEQPMP3
- WRITE @IOF
- +3 QUIT
- +4 ;
- DTE ; Edit Equipment Category PM data
- +1 IF '$DATA(^XUSEC("ENEDPM"))
- WRITE !!,"Sorry, you need Security Key 'ENEDPM'."
- DO HLD
- GOTO EXIT
- +2 NEW DIC,DIE,DA,DR,I,J,X,I1,TAG,K
- +3 SET DIC(0)="AEQML"
- SET DLAYGO=6911
- DO DTL
- KILL DLAYGO
- if ENDTYP'>0
- GOTO EXIT
- +4 LOCK +^ENG(6911,ENDTYP):1
- IF '$TEST
- WRITE !!,*7,"Someone else is editing this record."
- GOTO EXIT
- +5 SET DA=ENDTYP
- SET DR="[ENEQPMP]"
- DTE1 DO DDT^ENEQPMP3
- DO ^DIE
- +1 LOCK -^ENG(6911,ENDTYP)
- +2 if '$DATA(DA)
- GOTO DTE
- DTE2 WRITE !,"Are you finished with this Equipment Category"
- SET %=1
- DO YN^DICN
- if %=2
- GOTO DTE1
- if %<0
- GOTO DTE
- IF %=0
- WRITE !,"Please enter 'YES' or 'NO'."
- GOTO DTE2
- +1 SET ENDVTYP=$PIECE($GET(^ENG(6911,ENDTYP,0)),U)
- DTE3 IF $ORDER(^ENG(6911,ENDTYP,4,0))
- WRITE !,"Do you wish to assign this PM schedule to ALL existing equipment records",!,"in the category of "_ENDVTYP
- +1 IF '$TEST
- WRITE !,"Do you want to delete existing PM schedules (if any) from equipment records",!,"in the category of "_ENDVTYP
- +2 SET %=2
- DO YN^DICN
- SET TAG=$SELECT(%=1:"DTE5",%=2:"DTE",1:"DTE4")
- GOTO @TAG
- DTE4 DO DTEH
- GOTO DTE3
- DTE5 WRITE !,"Do you wish to confirm each transaction"
- SET %=2
- DO YN^DICN
- if %<1
- GOTO DTEH1
- SET ENCONF=$SELECT(%=1:1,1:0)
- +1 FOR DA=0:0
- SET DA=$ORDER(^ENG(6914,"G",ENDTYP,DA))
- if DA'>0
- QUIT
- WRITE !,DA
- if $DATA(^ENG(6914,DA,3))
- WRITE ?10,$PIECE(^(3),U,6)
- DO DTE51
- +2 DO HLD
- GOTO DTE
- DTE51 IF 'ENCONF
- DO PMSE3^ENEQPMP
- QUIT
- +1 WRITE " OK"
- SET %=1
- DO YN^DICN
- if %=1
- DO PMSE3^ENEQPMP
- +2 QUIT
- +3 ;
- DTL WRITE @IOF,!!
- SET (DIC,DIE)="^ENG(6911,"
- DO ^DIC
- SET ENDTYP=+Y
- +1 QUIT
- +2 ;
- DTEH WRITE !!,"'YES' will cause the system to immediately find every equipment record of",!,"type "_ENDVTYP_" and assign each of them the PM schedule just entered."
- +1 WRITE !,"The ENTRY NUMBER of each affected equipment record will be displayed at",!,"your terminal, but you will not be asked to confirm the transaction unless",!,"you say that you want to."
- +2 WRITE !,"Once this process has begun, it should not be interrupted."
- +3 QUIT
- DTEH1 WRITE !!,"You should enter 'YES' if you want to apply the revised schedule to some",!,ENDVTYP,"'s but not others."
- +1 WRITE !,"Enter 'NO' if you want the revised schedule applied to all equipment of",!,"type ",ENDVTYP,"."
- +2 GOTO DTE5
- SKPCK ;SKP MNTHS = ENA ;Called by FileMan Input X-form
- +1 SET ENA=X
- SET ENB=$PIECE(ENA,"-",2)
- SET ENA=$PIECE(ENA,"-",1)
- +2 IF ENA'="JUN"
- IF ENA'="SEP"
- IF ENA'="MAY"
- IF ENA'="OCT"
- IF ENA'="APR"
- IF ENA'="AUG"
- IF ENA'="JUL"
- IF ENA'="NOV"
- IF ENA'="MAR"
- IF ENA'="DEC"
- IF ENA'="FEB"
- IF ENA'="JAN"
- SET ENA="ERR"
- +3 IF ENB'="JUN"
- IF ENB'="SEP"
- IF ENB'="MAY"
- IF ENB'="OCT"
- IF ENB'="APR"
- IF ENB'="AUG"
- IF ENB'="JUL"
- IF ENB'="NOV"
- IF ENB'="MAR"
- IF ENB'="DEC"
- IF ENB'="FEB"
- IF ENB'="JAN"
- SET ENA="ERR"
- +4 IF ENA="ERR"!(ENB="ERR")
- DO EN^DDIOL("You seem to have an invalid entry for 'SKIP MONTHS'. Valid abbreviations are")
- DO EN^DDIOL("JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV, and DEC. Please re-edit.")
- +5 QUIT
- HLD IF $EXTRACT(IOST,1,2)="C-"
- READ !,"Press <RETURN> to continue...",X:DTIME
- +1 QUIT
- EXIT KILL ENDTYP,ENDVTYP,ENA,ENB,ENCRIT,ENXP,ENC,ENCONF,ENX
- +1 QUIT
- +2 ;
- RT ;Reassign a Technicians PMI Responsibilities
- +1 ;
- RTASK ; ask user
- +1 WRITE !
- +2 SET DIC=6929
- SET DIC(0)="AQEM"
- SET DIC("A")="Replace this TECHNICIAN: "
- +3 DO ^DIC
- KILL DIC
- if Y'>0
- GOTO RTEX
- SET ENTEC("O")=+Y
- SET ENTECN("O")=$PIECE(Y,U,2)
- +4 ;
- +5 SET DIC=6929
- SET DIC(0)="AQEM"
- SET DIC("A")="With this TECHNICIAN: "
- +6 DO ^DIC
- KILL DIC
- if Y'>0
- GOTO RTEX
- SET ENTEC("N")=+Y
- SET ENTECN("N")=$PIECE(Y,U,2)
- +7 ;
- +8 SET DIR(0)="S^0:ONE RESPONSIBLE SHOP;1:ALL RESPONSIBLE SHOPS"
- +9 SET DIR("A")="For PM schedules by"
- SET DIR("B")="ALL"
- +10 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- GOTO RTEX
- SET ENSHKEY("ALL")=Y
- +11 ;
- +12 IF 'ENSHKEY("ALL")
- Begin DoDot:1
- +13 SET DIC=6922
- SET DIC(0)="AQEM"
- DO ^DIC
- KILL DIC
- SET ENSHKEY=+Y
- SET ENSHOP=$PIECE(Y,U,2)
- End DoDot:1
- IF ENSHKEY'>0
- GOTO RTEX
- +14 ;
- +15 SET DIR(0)="Y"
- SET DIR("A")="Do you want to individually edit each entry"
- +16 SET DIR("B")="NO"
- +17 SET DIR("?",1)="If YES is entered here, the system will pause after each entry"
- +18 SET DIR("?",2)="for which TECHNICIAN "_ENTECN("O")_" has been changed"
- +19 SET DIR("?",3)="and allow you to edit the TECHNICIAN field."
- +20 SET DIR("?",4)=" "
- +21 SET DIR("?")="Enter YES or NO"
- +22 DO ^DIR
- KILL DIR
- if $DATA(DTOUT)
- GOTO RTEX
- SET ENEDTEC=Y
- +23 ;
- +24 WRITE !!,"All occurrences of TECHNICIAN in both the EQUIPMENT CATEGORY and"
- +25 WRITE !,"EQUIPMENT INV. preventive maintenance schedules will be changed"
- +26 WRITE !,"from ",ENTECN("O")," to ",ENTECN("N"),"."
- +27 WRITE !,"This change will be made for "
- +28 IF ENSHKEY("ALL")
- WRITE "the PM schedules of ALL responsible shops."
- +29 IF '$TEST
- WRITE "only the PM schedules of the ",ENSHOP," shop."
- +30 IF ENEDTEC
- WRITE !,"You will be able to individually edit the TECHNICAN."
- +31 WRITE !
- SET DIR(0)="Y"
- SET DIR("A")="OK to Proceed"
- +32 DO ^DIR
- KILL DIR
- if 'Y!$DATA(DIRUT)
- GOTO RTEX
- +33 ;
- RTDO SET END=0
- +1 WRITE !!,"Updating EQUIPMENT CATEGORY file"
- +2 IF ENEDTEC
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- SET END=1
- GOTO RTEX
- +3 SET (ENC,ENT)=0
- +4 SET ENDA=0
- FOR
- SET ENDA=$ORDER(^ENG(6911,ENDA))
- if 'ENDA
- QUIT
- Begin DoDot:1
- +5 SET ENI=0
- FOR
- SET ENI=$ORDER(^ENG(6911,ENDA,4,ENI))
- if 'ENI
- QUIT
- Begin DoDot:2
- +6 SET ENT=ENT+1
- +7 IF 'ENEDTEC
- if '(ENT#50)
- WRITE "."
- +8 SET ENY=$GET(^ENG(6911,ENDA,4,ENI,0))
- +9 SET ENRS=$PIECE(ENY,U)
- +10 IF 'ENSHKEY("ALL")
- IF ENRS'=ENSHKEY
- QUIT
- +11 IF $PIECE(ENY,U,2)'=ENTEC("O")
- QUIT
- +12 ;W !," ENDA: ",ENDA,?12,"ENI: ",ENI,?20,ENY
- +13 SET $PIECE(^ENG(6911,ENDA,4,ENI,0),U,2)=ENTEC("N")
- +14 SET ENC=ENC+1
- +15 IF ENEDTEC
- Begin DoDot:3
- +16 SET ENDTYP=ENDA
- SET ENNOHLD=1
- DO DDT^ENEQPMP3
- +17 WRITE !!,"For the ",$PIECE($GET(^DIC(6922,ENRS,0)),U)," SHOP PM Schedule:"
- +18 SET DIE="^ENG(6911,"_ENDA_",4,"
- SET DA(1)=ENDA
- SET DA=ENI
- SET DR="1"
- +19 DO ^DIE
- KILL DA
- if $DATA(Y)
- SET END=1
- End DoDot:3
- End DoDot:2
- if END
- QUIT
- End DoDot:1
- if END
- QUIT
- +20 WRITE !," ",ENC,$SELECT(ENC=1:" entry was",1:" entries were")," changed."
- +21 if END
- GOTO RTEX
- +22 ;
- +23 WRITE !!,"Updating EQUIPMENT INV. file"
- +24 IF ENEDTEC
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- SET END=1
- GOTO RTEX
- +25 SET (ENC,ENT)=0
- +26 IF 'ENSHKEY("ALL")
- SET ENRS=ENSHKEY
- DO RTSHOP
- +27 IF ENSHKEY("ALL")
- SET ENRS=0
- FOR
- SET ENRS=$ORDER(^ENG(6914,"AB",ENRS))
- if 'ENRS
- QUIT
- DO RTSHOP
- if END
- QUIT
- +28 WRITE !," ",ENC,$SELECT(ENC=1:" entry was",1:" entries were")," changed."
- +29 ;
- RTEX ; reassign tech exit
- +1 KILL DA,DIC,DIE,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,Y
- +2 KILL ENC,END,ENDA,ENDTYP,ENDVTYP,ENEDTEC,ENI,ENNOHLD,ENRS
- +3 KILL ENSHKEY,ENSHOP,ENT,ENTEC,ENTECN,ENX,ENY
- +4 QUIT
- +5 ;
- RTSHOP ; update all entries for responsible shop ENRS
- +1 SET ENDA=0
- FOR
- SET ENDA=$ORDER(^ENG(6914,"AB",ENRS,ENDA))
- if 'ENDA
- QUIT
- Begin DoDot:1
- +2 SET ENT=ENT+1
- +3 IF 'ENEDTEC
- if '(ENT#50)
- WRITE "."
- +4 SET ENI=$ORDER(^ENG(6914,"AB",ENRS,ENDA,0))
- +5 SET ENY=$GET(^ENG(6914,ENDA,4,ENI,0))
- +6 IF $PIECE(ENY,U,2)'=ENTEC("O")
- QUIT
- +7 ;W !," ENDA: ",ENDA,?12,"ENI: ",ENI,?20,ENY
- +8 SET $PIECE(^ENG(6914,ENDA,4,ENI,0),U,2)=ENTEC("N")
- +9 SET ENC=ENC+1
- +10 IF ENEDTEC
- Begin DoDot:2
- +11 SET DA=ENDA
- SET ENNOHLD=1
- DO DINV^ENEQPMP3
- +12 WRITE !!,"For the ",$PIECE($GET(^DIC(6922,ENRS,0)),U)," SHOP PM Schedule:"
- +13 SET DIE="^ENG(6914,"_ENDA_",4,"
- SET DA(1)=ENDA
- SET DA=ENI
- SET DR="1"
- +14 DO ^DIE
- KILL DA
- if $DATA(Y)
- SET END=1
- End DoDot:2
- End DoDot:1
- if END
- QUIT
- +15 QUIT
- +16 ;
- +17 ;ENEQPMP1