source: WorldVistAEHR/trunk/r/CMOP-PSX/PSX41PST.m@ 702

Last change on this file since 702 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1PSX41PST ;BIR/PDW-New indexes in PSX patch 41, MOVE 550.1 INTO 550.21 ;08/12/2002
2 ;;2.0;CMOP;**41**;11 Apr 97
3 ;; Reference to ^PS(52.5, supported by DBIA #1978
4 ;; Reference to ^PSOCMOP supported by DBIA #2476
5 Q
6EN ;
7 I ^XMB("NETNAME")?1"CMOP-".E Q
8 D EN^PSX41NDX ; clear and build indexes in *41
9 ;
105501 ; REMOVE ENTRIES FROM 550.1
11 I ^XMB("NETNAME")?1"CMOP-".E Q
12 K ^PSX(550.1) S ^PSX(550.1,0)="CMOP RX QUEUE^550.1^0^0"
13 ;
145502 D COR5502
15 D CMPNDX
16MSG ; print reminder to use Kernel tasking
17 I ^XMB("NETNAME")?1"CMOP-".E Q
18 W !
19 F I=1:1 S X=$T(TXT+I) Q:X["END" W !,$P(X,";;",2)
20 W !!,"^^^ PLEASE NOTE THE ABOVE ^^^^"
21 W !,"Pausing 20 seconds" F I=1:1:20 W "." H 1
22 Q
23TXT ;
24 ;;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
25 ;;
26 ;;The following PSX options must be placed into the Option Scheduling File
27 ;;using the Kernel Taskman menu Schedule/Unschedule Options.
28 ;;
29 ;; PSXR SCHEDULED CS TRANS
30 ;; PSXR SCHEDULED NON-CS TRANS
31 ;;
32 ;;This must be done so they can be accessed through the CMOP menus.
33 ;;
34 ;;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
35 ;;END
36 Q
37COR5502 ;correct Total RXs field from PSX*2*41 v25
38 S PSXDT=$O(^PSX(550.2,"D",3030325)) Q:'PSXDT
39 S PSXTDA=$O(^PSX(550.2,"D",PSXDT,0))
40 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
41 . S TOTRX=$P(XX,"5///"),$P(^PSX(550.2,BATDA,1),"^",8)=TOTRX
42 Q
43CMPNDX ; new compound index on CMOP Indicator "CMP"
44 ;check "A_x" indexes to CMP index
45 W !,"Updating the RX Suspense file's new 'CMP' index."
46 W !,"Processing the AQ, AL, AX, AP indexes into the CMP index"
47 F NDX="Q","L","X","P" D
48 . S INDX="A"_NDX W !!,INDX
49 . S SDT=0 F S SDT=$O(^PS(52.5,INDX,SDT)) Q:'SDT D
50 .. S DFN=0 F S DFN=$O(^PS(52.5,INDX,SDT,DFN)) Q:'DFN D
51 ... S REC=0 F S REC=$O(^PS(52.5,INDX,SDT,DFN,REC)) Q:'REC D
52 .... S F=$G(^PS(52.5,REC,0))
53 .... I 'F K ^PS(52.5,INDX,SDT,DFN,REC) Q ;bad index
54 .... S TYP=$$CMPRXTYP^PSOCMOP(REC),CNT=$G(CNT)+1 I '(CNT#100) W "."
55 .... F VP="RX^1","SDT0^2","DFN0^3","DIV^6","STAT^7" D PIECE(F,U,VP)
56 .... I NDX=STAT,DFN=DFN0,SDT=SDT0
57 .... E K ^PS(52.5,INDX,SDT,DFN,REC)
58 .... I STAT'="",'$D(^PS(52.5,"CMP",STAT,TYP,DIV,SDT0,DFN,REC)) D
59 ..... S ^PS(52.5,"CMP",NDX,TYP,DIV,SDT,DFN,REC)=""
60 Q
61PIECE(REC,DLM,VP) ; VP="Variable^Piece" : S Variable=$P(REC,DLM,Piece)
62 N V,P S V=$P(VP,DLM),P=$P(VP,DLM,2),@V=$P(REC,DLM,P)
63 Q
Note: See TracBrowser for help on using the repository browser.