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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSX41PST 2503 printed Dec 13, 2024@01:43:15 Page 2
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
