- PSGWXREF ;BHAM ISC/CML-Background job to re-index the "AMIS" xref for inventories, on-demands, and returns ; 08 Dec 93 / 9:03 AM
- ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- ;ODT=ON-DEMAND DATE TIME;ADA=AOU INTERNAL #;DDA=ITEM INTERNAL #;ODA=ON-DEMAND INTERNAL #;RET=RETURN INTERNAL #;INV=INVENTORY INTERNAL #
- W !!,"This option will re-index the ""AMIS"" cross-reference for Inventories, On-Demand",!,"Requests, and Returns for a date range beginning with the START DATE you specify",!,"to the time the job runs."
- W !!?34,"** WARNING **",!?22,"Since this option is CPU intensive,",!?17,"it should be QUEUED to run in the ""off"" hours!",!!
- ASK1 W ! S %DT("A")="Select START DATE for re-index: ",%DT(0)="-NOW",%DT="AETX" D ^%DT G:Y<0 QUIT S START=Y
- ASK2 X ^DD("DD") W !!,"The ""AMIS"" cross-reference will now be re-indexed starting from ",Y,"."
- F JJ=0:0 W !!,"Are you SURE that is what you want to do" S %=2 D YN^DICN Q:% D HELP
- G:%'=1 QUIT S ZTIO="",ZTRTN="START^PSGWXREF",ZTDESC="Re-index AR/WS 'AMIS' xref" S:$D(START) ZTSAVE("START")=""
- D ^%ZTLOAD,HOME^%ZIS I $D(ZTSK) W !!,"""AMIS"" cross reference re-indexing queued!" K ZTSK
- G QUIT
- START ; Entry point from queue
- ; Delete existing "AMIS" xref
- L +^PSI(58.5,"AMIS")
- S SUB1="" F JJ=0:0 S SUB1=$O(^PSI(58.5,"AMIS",SUB1)) Q:SUB1="" F KDT=START-.000001:0 S KDT=$O(^PSI(58.5,"AMIS",SUB1,KDT)) Q:'KDT K ^(KDT)
- D INV,OND,RET
- QUIT K %,%DT,%I,%H,ZTSK,ZTIO,JJ,ODT,ADA,DDA,ODA,DA,RET,INV,ANS,START,SUB1,KDT,QD,X,Y L -^PSI(58.5,"AMIS")
- S:$D(ZTQUEUED) ZTREQ="@" Q
- INV ; Re-index Inventories
- F ADA=0:0 S ADA=$O(^PSI(58.1,ADA)) Q:'ADA F DDA=0:0 S DDA=$O(^PSI(58.1,ADA,1,DDA)) Q:'DDA F INV=0:0 S INV=$O(^PSI(58.1,ADA,1,DDA,1,INV)) Q:'INV I $D(^PSI(58.19,INV,0)),$P(^(0),"^")'<START D SETINV
- Q
- SETINV ;
- S QD=$P(^PSI(58.1,ADA,1,DDA,1,INV,0),"^",5),DA(2)=ADA,DA(1)=DDA,DA=INV,X=QD I X D QD^PSGWUTL
- Q
- OND ; Re-index On-Demands
- F ODT=START-.000001:0 S ODT=$O(^PSI(58.1,"OND",ODT)) Q:'ODT F ADA=0:0 S ADA=$O(^PSI(58.1,"OND",ODT,ADA)) Q:'ADA F DDA=0:0 S DDA=$O(^PSI(58.1,"OND",ODT,ADA,DDA)) Q:'DDA S ODA=$O(^PSI(58.1,"OND",ODT,ADA,DDA,0)) D SETOND
- Q
- SETOND S QD=$P(^PSI(58.1,ADA,1,DDA,5,ODA,0),"^",2),DA(2)=ADA,DA(1)=DDA,DA=ODA,X=QD I X D OD^PSGWUTL
- Q
- RET ; Re-index Returns
- F ADA=0:0 S ADA=$O(^PSI(58.1,ADA)) Q:'ADA F DDA=0:0 S DDA=$O(^PSI(58.1,ADA,1,DDA)) Q:'DDA F RET=0:0 S RET=$O(^PSI(58.1,ADA,1,DDA,3,RET)) Q:'RET I $P(^(RET,0),"^")'<START D SETRET
- Q
- SETRET ;
- S QD=$P(^PSI(58.1,ADA,1,DDA,3,RET,0),"^",2),DA(2)=ADA,DA(1)=DDA,DA=RET,X=QD I X D RET^PSGWUTL
- Q
- HELP ;
- W !?5,"Enter 'YES' if you are satisfied with the selected date range.",!?5,"Enter 'NO' or '^' if you wish to abort the re-indexing." Q
- PSGWXREF ;BHAM ISC/CML-Background job to re-index the "AMIS" xref for inventories, on-demands, and returns ; 08 Dec 93 / 9:03 AM
- +1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- +2 ;ODT=ON-DEMAND DATE TIME;ADA=AOU INTERNAL #;DDA=ITEM INTERNAL #;ODA=ON-DEMAND INTERNAL #;RET=RETURN INTERNAL #;INV=INVENTORY INTERNAL #
- +3 WRITE !!,"This option will re-index the ""AMIS"" cross-reference for Inventories, On-Demand",!,"Requests, and Returns for a date range beginning with the START DATE you specify",!,"to the time the job runs."
- +4 WRITE !!?34,"** WARNING **",!?22,"Since this option is CPU intensive,",!?17,"it should be QUEUED to run in the ""off"" hours!",!!
- ASK1 WRITE !
- SET %DT("A")="Select START DATE for re-index: "
- SET %DT(0)="-NOW"
- SET %DT="AETX"
- DO ^%DT
- IF Y<0
- GOTO QUIT
- SET START=Y
- ASK2 XECUTE ^DD("DD")
- WRITE !!,"The ""AMIS"" cross-reference will now be re-indexed starting from ",Y,"."
- +1 FOR JJ=0:0
- WRITE !!,"Are you SURE that is what you want to do"
- SET %=2
- DO YN^DICN
- IF %
- QUIT
- DO HELP
- +2 IF %'=1
- GOTO QUIT
- SET ZTIO=""
- SET ZTRTN="START^PSGWXREF"
- SET ZTDESC="Re-index AR/WS 'AMIS' xref"
- IF $DATA(START)
- SET ZTSAVE("START")=""
- +3 DO ^%ZTLOAD
- DO HOME^%ZIS
- IF $DATA(ZTSK)
- WRITE !!,"""AMIS"" cross reference re-indexing queued!"
- KILL ZTSK
- +4 GOTO QUIT
- START ; Entry point from queue
- +1 ; Delete existing "AMIS" xref
- +2 LOCK +^PSI(58.5,"AMIS")
- +3 SET SUB1=""
- FOR JJ=0:0
- SET SUB1=$ORDER(^PSI(58.5,"AMIS",SUB1))
- IF SUB1=""
- QUIT
- FOR KDT=START-.000001:0
- SET KDT=$ORDER(^PSI(58.5,"AMIS",SUB1,KDT))
- IF 'KDT
- QUIT
- KILL ^(KDT)
- +4 DO INV
- DO OND
- DO RET
- QUIT KILL %,%DT,%I,%H,ZTSK,ZTIO,JJ,ODT,ADA,DDA,ODA,DA,RET,INV,ANS,START,SUB1,KDT,QD,X,Y
- LOCK -^PSI(58.5,"AMIS")
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- INV ; Re-index Inventories
- +1 FOR ADA=0:0
- SET ADA=$ORDER(^PSI(58.1,ADA))
- IF 'ADA
- QUIT
- FOR DDA=0:0
- SET DDA=$ORDER(^PSI(58.1,ADA,1,DDA))
- IF 'DDA
- QUIT
- FOR INV=0:0
- SET INV=$ORDER(^PSI(58.1,ADA,1,DDA,1,INV))
- IF 'INV
- QUIT
- IF $DATA(^PSI(58.19,INV,0))
- IF $PIECE(^(0),"^")'<START
- DO SETINV
- +2 QUIT
- SETINV ;
- +1 SET QD=$PIECE(^PSI(58.1,ADA,1,DDA,1,INV,0),"^",5)
- SET DA(2)=ADA
- SET DA(1)=DDA
- SET DA=INV
- SET X=QD
- IF X
- DO QD^PSGWUTL
- +2 QUIT
- OND ; Re-index On-Demands
- +1 FOR ODT=START-.000001:0
- SET ODT=$ORDER(^PSI(58.1,"OND",ODT))
- IF 'ODT
- QUIT
- FOR ADA=0:0
- SET ADA=$ORDER(^PSI(58.1,"OND",ODT,ADA))
- IF 'ADA
- QUIT
- FOR DDA=0:0
- SET DDA=$ORDER(^PSI(58.1,"OND",ODT,ADA,DDA))
- IF 'DDA
- QUIT
- SET ODA=$ORDER(^PSI(58.1,"OND",ODT,ADA,DDA,0))
- DO SETOND
- +2 QUIT
- SETOND SET QD=$PIECE(^PSI(58.1,ADA,1,DDA,5,ODA,0),"^",2)
- SET DA(2)=ADA
- SET DA(1)=DDA
- SET DA=ODA
- SET X=QD
- IF X
- DO OD^PSGWUTL
- +1 QUIT
- RET ; Re-index Returns
- +1 FOR ADA=0:0
- SET ADA=$ORDER(^PSI(58.1,ADA))
- IF 'ADA
- QUIT
- FOR DDA=0:0
- SET DDA=$ORDER(^PSI(58.1,ADA,1,DDA))
- IF 'DDA
- QUIT
- FOR RET=0:0
- SET RET=$ORDER(^PSI(58.1,ADA,1,DDA,3,RET))
- IF 'RET
- QUIT
- IF $PIECE(^(RET,0),"^")'<START
- DO SETRET
- +2 QUIT
- SETRET ;
- +1 SET QD=$PIECE(^PSI(58.1,ADA,1,DDA,3,RET,0),"^",2)
- SET DA(2)=ADA
- SET DA(1)=DDA
- SET DA=RET
- SET X=QD
- IF X
- DO RET^PSGWUTL
- +2 QUIT
- HELP ;
- +1 WRITE !?5,"Enter 'YES' if you are satisfied with the selected date range.",!?5,"Enter 'NO' or '^' if you wish to abort the re-indexing."
- QUIT
