- PSX41PST ;BIR/PDW-New indexes in PSX patch 41, MOVE 550.1 INTO 550.21 ;08/12/2002
- ;;2.0;CMOP;**41**;11 Apr 97
- ;; Reference to ^PS(52.5, supported by DBIA #1978
- ;; Reference to ^PSOCMOP supported by DBIA #2476
- Q
- EN ;
- I ^XMB("NETNAME")?1"CMOP-".E Q
- D EN^PSX41NDX ; clear and build indexes in *41
- ;
- 5501 ; REMOVE ENTRIES FROM 550.1
- I ^XMB("NETNAME")?1"CMOP-".E Q
- K ^PSX(550.1) S ^PSX(550.1,0)="CMOP RX QUEUE^550.1^0^0"
- ;
- 5502 D COR5502
- D CMPNDX
- MSG ; print reminder to use Kernel tasking
- I ^XMB("NETNAME")?1"CMOP-".E Q
- W !
- F I=1:1 S X=$T(TXT+I) Q:X["END" W !,$P(X,";;",2)
- W !!,"^^^ PLEASE NOTE THE ABOVE ^^^^"
- W !,"Pausing 20 seconds" F I=1:1:20 W "." H 1
- Q
- TXT ;
- ;;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
- ;;
- ;;The following PSX options must be placed into the Option Scheduling File
- ;;using the Kernel Taskman menu Schedule/Unschedule Options.
- ;;
- ;; PSXR SCHEDULED CS TRANS
- ;; PSXR SCHEDULED NON-CS TRANS
- ;;
- ;;This must be done so they can be accessed through the CMOP menus.
- ;;
- ;;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
- ;;END
- Q
- COR5502 ;correct Total RXs field from PSX*2*41 v25
- S PSXDT=$O(^PSX(550.2,"D",3030325)) Q:'PSXDT
- S PSXTDA=$O(^PSX(550.2,"D",PSXDT,0))
- S BATDA=PSXTDA-.1 F S BATDA=$O(^PSX(550.2,BATDA)) Q:BATDA'>0 S XX=$P($G(^PSX(550.2,BATDA,1)),"^",8) I XX'=+XX,XX["5///" D
- . S TOTRX=$P(XX,"5///"),$P(^PSX(550.2,BATDA,1),"^",8)=TOTRX
- Q
- CMPNDX ; new compound index on CMOP Indicator "CMP"
- ;check "A_x" indexes to CMP index
- W !,"Updating the RX Suspense file's new 'CMP' index."
- W !,"Processing the AQ, AL, AX, AP indexes into the CMP index"
- F NDX="Q","L","X","P" D
- . S INDX="A"_NDX W !!,INDX
- . S SDT=0 F S SDT=$O(^PS(52.5,INDX,SDT)) Q:'SDT D
- .. S DFN=0 F S DFN=$O(^PS(52.5,INDX,SDT,DFN)) Q:'DFN D
- ... S REC=0 F S REC=$O(^PS(52.5,INDX,SDT,DFN,REC)) Q:'REC D
- .... S F=$G(^PS(52.5,REC,0))
- .... I 'F K ^PS(52.5,INDX,SDT,DFN,REC) Q ;bad index
- .... S TYP=$$CMPRXTYP^PSOCMOP(REC),CNT=$G(CNT)+1 I '(CNT#100) W "."
- .... F VP="RX^1","SDT0^2","DFN0^3","DIV^6","STAT^7" D PIECE(F,U,VP)
- .... I NDX=STAT,DFN=DFN0,SDT=SDT0
- .... E K ^PS(52.5,INDX,SDT,DFN,REC)
- .... I STAT'="",'$D(^PS(52.5,"CMP",STAT,TYP,DIV,SDT0,DFN,REC)) D
- ..... S ^PS(52.5,"CMP",NDX,TYP,DIV,SDT,DFN,REC)=""
- Q
- PIECE(REC,DLM,VP) ; VP="Variable^Piece" : S Variable=$P(REC,DLM,Piece)
- N V,P S V=$P(VP,DLM),P=$P(VP,DLM,2),@V=$P(REC,DLM,P)
- Q
- PSX41PST ;BIR/PDW-New indexes in PSX patch 41, MOVE 550.1 INTO 550.21 ;08/12/2002
- +1 ;;2.0;CMOP;**41**;11 Apr 97
- +2 ;; Reference to ^PS(52.5, supported by DBIA #1978
- +3 ;; Reference to ^PSOCMOP supported by DBIA #2476
- +4 QUIT
- EN ;
- +1 IF ^XMB("NETNAME")?1"CMOP-".E
- QUIT
- +2 ; clear and build indexes in *41
- DO EN^PSX41NDX
- +3 ;
- 5501 ; REMOVE ENTRIES FROM 550.1
- +1 IF ^XMB("NETNAME")?1"CMOP-".E
- QUIT
- +2 KILL ^PSX(550.1)
- SET ^PSX(550.1,0)="CMOP RX QUEUE^550.1^0^0"
- +3 ;
- 5502 DO COR5502
- +1 DO CMPNDX
- MSG ; print reminder to use Kernel tasking
- +1 IF ^XMB("NETNAME")?1"CMOP-".E
- QUIT
- +2 WRITE !
- +3 FOR I=1:1
- SET X=$TEXT(TXT+I)
- IF X["END"
- QUIT
- WRITE !,$PIECE(X,";;",2)
- +4 WRITE !!,"^^^ PLEASE NOTE THE ABOVE ^^^^"
- +5 WRITE !,"Pausing 20 seconds"
- FOR I=1:1:20
- WRITE "."
- HANG 1
- +6 QUIT
- TXT ;
- +1 ;;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
- +2 ;;
- +3 ;;The following PSX options must be placed into the Option Scheduling File
- +4 ;;using the Kernel Taskman menu Schedule/Unschedule Options.
- +5 ;;
- +6 ;; PSXR SCHEDULED CS TRANS
- +7 ;; PSXR SCHEDULED NON-CS TRANS
- +8 ;;
- +9 ;;This must be done so they can be accessed through the CMOP menus.
- +10 ;;
- +11 ;;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
- +12 ;;END
- +13 QUIT
- COR5502 ;correct Total RXs field from PSX*2*41 v25
- +1 SET PSXDT=$ORDER(^PSX(550.2,"D",3030325))
- IF 'PSXDT
- QUIT
- +2 SET PSXTDA=$ORDER(^PSX(550.2,"D",PSXDT,0))
- +3 SET BATDA=PSXTDA-.1
- FOR
- SET BATDA=$ORDER(^PSX(550.2,BATDA))
- IF BATDA'>0
- QUIT
- SET XX=$PIECE($GET(^PSX(550.2,BATDA,1)),"^",8)
- IF XX'=+XX
- IF XX["5///"
- Begin DoDot:1
- +4 SET TOTRX=$PIECE(XX,"5///")
- SET $PIECE(^PSX(550.2,BATDA,1),"^",8)=TOTRX
- End DoDot:1
- +5 QUIT
- CMPNDX ; new compound index on CMOP Indicator "CMP"
- +1 ;check "A_x" indexes to CMP index
- +2 WRITE !,"Updating the RX Suspense file's new 'CMP' index."
- +3 WRITE !,"Processing the AQ, AL, AX, AP indexes into the CMP index"
- +4 FOR NDX="Q","L","X","P"
- Begin DoDot:1
- +5 SET INDX="A"_NDX
- WRITE !!,INDX
- +6 SET SDT=0
- FOR
- SET SDT=$ORDER(^PS(52.5,INDX,SDT))
- IF 'SDT
- QUIT
- Begin DoDot:2
- +7 SET DFN=0
- FOR
- SET DFN=$ORDER(^PS(52.5,INDX,SDT,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:3
- +8 SET REC=0
- FOR
- SET REC=$ORDER(^PS(52.5,INDX,SDT,DFN,REC))
- IF 'REC
- QUIT
- Begin DoDot:4
- +9 SET F=$GET(^PS(52.5,REC,0))
- +10 ;bad index
- IF 'F
- KILL ^PS(52.5,INDX,SDT,DFN,REC)
- QUIT
- +11 SET TYP=$$CMPRXTYP^PSOCMOP(REC)
- SET CNT=$GET(CNT)+1
- IF '(CNT#100)
- WRITE "."
- +12 FOR VP="RX^1","SDT0^2","DFN0^3","DIV^6","STAT^7"
- DO PIECE(F,U,VP)
- +13 IF NDX=STAT
- IF DFN=DFN0
- IF SDT=SDT0
- +14 IF '$TEST
- KILL ^PS(52.5,INDX,SDT,DFN,REC)
- +15 IF STAT'=""
- IF '$DATA(^PS(52.5,"CMP",STAT,TYP,DIV,SDT0,DFN,REC))
- Begin DoDot:5
- +16 SET ^PS(52.5,"CMP",NDX,TYP,DIV,SDT,DFN,REC)=""
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +17 QUIT
- PIECE(REC,DLM,VP) ; VP="Variable^Piece" : S Variable=$P(REC,DLM,Piece)
- +1 NEW V,P
- SET V=$PIECE(VP,DLM)
- SET P=$PIECE(VP,DLM,2)
- SET @V=$PIECE(REC,DLM,P)
- +2 QUIT
