source: WorldVistAEHR/trunk/r/CMOP-PSX/PSXOPUTL.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.2 KB
RevLine 
[613]1PSXOPUTL ;BIR/HTW-Utility for Hold/Can ;[ 04/08/97 2:06 PM ]
2 ;;2.0;CMOP;;11 Apr 97
3 ;Required input: DA - internal entry # - ^PSRX
4 ;Returns:
5 ;PSXZ("L")=LAST FILL... if it is orig Rx =0
6 ;PSXZ(FILL #)=CMOP status from 52...Trans/0,DISP/1,RETRAN/2,NOT DISP/3
7 ;If suspended PSXZ("S")=CMOP suspense status Q,L,X,P,R
8 ;All returned variables can be killed by K PSXZ
9 ;
10 N X
11 S (PSXZ("L"),X)=0 F S X=$O(^PSRX(DA,1,X)) Q:'X S PSXZ("L")=X
12 I $O(^PSRX(DA,4,0)) F X=0:0 S X=$O(^PSRX(DA,4,X)) Q:'X D
13 .S PSXZ($P($G(^PSRX(DA,4,X,0)),"^",3))=$P($G(^(0)),"^",4)
14 S X=$O(^PS(52.5,"B",DA,0)) I X]"" S PSXZ("S")=$P($G(^PS(52.5,X,0)),"^",7)
15 K X
16 Q
17UNHOLD N FDT S FDT=PSORX("FILL DATE"),PSXFROM="UNHOLD" G EN1
18REINS S PSXFROM="REINSTATE"
19EN1 D SUS1^PSXNEW I '$G(PSXFLAG) G KILL
20 D PSXOPUTL
21 I $G(PSXEDREL)]""!($G(PSXZ(PSXZ("L")))=0)!($G(PSXZ(PSXZ("L")))=2) D G KILL
22 .I PSXFROM="REINSTATE" W !!,RX_" REINSTATED -- ",! Q
23 .I PSXFROM="UNHOLD" W !!,$P(^PSRX(DA,0),"^")_" Removed from Hold Status",!!
24 I $G(PSXZ(PSXZ("L")))']"" D S^PSXNEW G KILL
25 I $G(PSXZ(PSXZ("L")))=3,(FDT>DT) D S^PSXNEW G KILL
26 I $G(PSXZ(PSXZ("L")))=3,((FDT<DT)!(FDT=DT)) D QS
27KILL D D1^PSXNEW
28 K PSXZ,DIR,X,DIRUT,DUOUT,Y,DTOUT,PSXFROM
29 Q
30 ;
31QS W !! S DIR("A")="LABEL: QUEUE"_$S($P(PSOPAR,"^",24):"/SUSPEND",1:"")_" or '^' to bypass "
32 S DIR("?",1)="Enter 'Q' to queue labels for printing" S:$P(PSOPAR,"^",24) DIR("?",2)="Enter 'S' to suspend labels for printing at a later date"
33 S DIR(0)="SA^Q:QUEUE"_$S($P(PSOPAR,"^",24):";S:SUSPENSE",1:""),DIR("B")="Q" D ^DIR K DIR
34 I $D(DUOUT)!$D(DIRUT) G KILL
35 I $G(Y)="S" D S^PSXNEW K PSXZ Q
36 I $G(Y)="Q" D D1^PSXNEW K PSXZ I $G(PSOLAP)]"",($G(PSOLAP)'=ION) S PPL=DA D QLBL^PSORXL Q
37 I $G(Y)="Q" S PPL=DA D Q1^PSORXL
38 Q
39HLD N PSOFROM S PSOFROM="HOLD"
40EN ; Called from PSORXDL,HLD+4^PSOHLD, PSOCAN
41 ; if in suspense and "loading" no delete
42 Q:'$G(DA) D ^PSXOPUTL
43 I $G(PSXZ("S"))="L" D MSG K PSXZ Q
44 I $G(PSOFROM)="DELETE",($G(PSXZ(PSXZ("L")))=0!($G(PSXZ(PSXZ("L")))=2)) D MSG
45 K PSXZ
46 Q
47MSG W !!,"A CMOP Rx cannot be"_$S($G(PSOFROM)="HOLD":" placed on HOLD",$G(PSOFROM)="CANCEL":" CANCELLED",1:" DELETED")
48 W $S($G(PSOFROM)="DELETE":" while in",1:" during")
49 W $S($G(PSOFROM)="DELETE":" transmission status!",1:" transmission! ")_" Try later.",!!
50 S PSXDFLAG=1
51 Q
52CMOP ;
53 I $D(^PSRX(RXN,4)) F PSXZ=0:0 S PSXZ=$O(^PSRX(RXN,4,PSXZ)) Q:'PSXZ D
54 .S PSX($P(^PSRX(RXN,4,PSXZ,0),U,3))=$P(^PSRX(RXN,4,PSXZ,0),U,4)
55 K PSXZ
56 Q
57DUPCAN N DA,PSOFROM S DA=+PSOSD(DNM),PSOFROM="CANCEL" G EN
58 ;Called from ASK+4^PSORENW
59MW(PSODIR) ;
60 K DIR,DIC
61 S DIR(0)="52,11"
62 S DIR("B")=$S($G(PSORX("MAIL/WINDOW"))]"":PSORX("MAIL/WINDOW"),1:"WINDOW")
63 D DIR G:PSODIR("DFLG")!PSODIR("FIELD") MWX
64 I $G(Y(0))']"" S PSODIR("DFLG")=1 G MWX
65 S PSODIR("MAIL/WINDOW")=Y,PSORX("MAIL/WINDOW")=Y(0)
66MW1 G:PSODIR("MAIL/WINDOW")'="W"!('$P($G(PSOPAR),"^",12)) MWX
67 S DIR(0)="52,35O"
68 S:$G(PSORX("METHOD OF PICK-UP"))]"" DIR("B")=PSORX("METHOD OF PICK-UP")
69 D DIR G:PSODIR("DFLG") MWX
70 I X[U W !,"Cannot jump to another field ..",! G MW1
71 S (PSODIR("METHOD OF PICK-UP"),PSORX("METHOD OF PICK-UP"))=Y
72MWX K X,Y
73 Q
74DIR ;
75 S PSODIR("FIELD")=0
76 G:$G(DIR(0))']"" DIRX
77 D ^DIR K DIR,DIE,DIC,DA
78 I $D(DUOUT)!($D(DTOUT))!($D(DIROUT)),$L($G(X))'>1!(Y="") S PSODIR("DFLG")=1 G DIRX
79DIRX K DIRUT,DTOUT,DUOUT,DIROUT,PSOX
80 Q
Note: See TracBrowser for help on using the repository browser.