source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJPR.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1PSJPR ;BIR/CML3-INPATIENT MEDICATIONS PROFILE ;25 SEP 97 / 7:43 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**31,111,122**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA# 2191
5 ;
6 N PFLG,PSJNEW,PSGPTMP,PPAGE,QFLG S PSJNEW=1
7 N PSGLI,PSGWD,PSJAT,PSJPNRB,PSJPWDO,PSJSTOP,PSJTEAM
8 ;
9EN ;
10 G:$D(XQUIT) DONE
11 D @$S('$D(PSJEXTP):"^PSIVXU",1:"ENCV^PSGSETU")
12 G:$D(XQUIT) DONE S PSGPTMP=0,PPAGE=1 K PSJSEL D @$S($D(PSJEXTP):"P^PSJPDIR",1:"GWP^PSJPDIR") G:$G(PSJSTOP)=1 DONE S:$D(PSJEXTP) PSJSEL("SELECT")="P"
13 I $G(PSJSEL("WG"))="^OTHER",PSJSEL("SELECT")="G",PSJSTOP=2 S PSJSEL("SELECT")="C",PSJSEL("RBP")="P"
14 D ENL^PSJO3 G:"^N"[PSJOL EN D GO
15 ;
16DONE ;
17 K ^TMP("PSJON",$J),^TMP("PSJ",$J)
18 D ENIVKV^PSGSETU K AND,AT,C,CA,DDH,DFN,DN,DOB,DRGI,DRGN,DRGT,FIL,FQC,HDR,I1,J,JJ,MF,NF,O,OD,ON,ON55,P,P1,PDRG,PG,PPN,PRI,PRIV,PSGLMT,PSGOE,PSGONC,PSGONR,PSGONV,PSGORD,PSGSS,PSGSSH,PSGON,PSGPR,PSGPRP
19 K PSIVAC,PSIVCT,PSIVREA,PSIVSCR,PSIVUP,PSIVX
20 K PSJACNWP,PSJACOK,PSJDEV,PSJDBL,PSJION,PSJOL,PSJON,PSJOS,PSJP,PSJSEL,PSJSS,PSJSSH,PSJPRW,PSJPRWN,PSJPRWG,PSJPRWGN
21 K PSJOPC,PSJORD,PSJQ,PSJIVOF,PSJOCNT,PSJPR,PSJPRA,PSJPRF,PSJPRP,PSJON,PSJS1,PSJS2,PSJS3,PSJS4,PSJPR,PX,HDT,PSGODT,RF,SD,SLS,SSN,TF,UD,WD,WDP,WT,PSJORIFN,RB,RCT,SUB,XQUIT,ZTOUT
22 ;*
23 ;* K PSGLI,PSGWD,PSJAT,PSJPNRB,PSJPWDO,PSJSTOP,PSJTEAM
24 Q
25 ;
26GO ;
27 S PSJPRP="P",PSJPRA="" G:PSJSEL("SELECT")'="P" DEV
28 N DIR S DIR(0)="SAO^P:PROFILE;E:EXPANDED VIEWS;B:BOTH",DIR("A")="Show PROFILE only, EXPANDED VIEWS only, or BOTH: ",DIR("B")="PROFILE",DIR("?")="^D PH^PSJPR" W ! D ^DIR G:"^"[Y EN S PSJPRP=Y
29 I "EB"[PSJPRP F R !!,"Show SHORT, LONG, or NO activity log? NO// ",AT:DTIME D ALC^PSGVW0 I Q S PSJPRA=AT Q
30 G:PSJPRA="^" EN
31DEV ;
32 S PSJOS=$P(PSJSYSP0,"^",11)
33 K ZTSAVE S PSGTIR="ENQ^PSJPR",ZTDESC="INPATIENT PATIENT PROFILE" F X="DFN","PSJSEL(","PSJOL","PSJOS","PSJPRA","PSJPRP","PSGPTMP","PPAGE","PSJEXTP","PSJHDATE" S ZTSAVE(X)=""
34 D ENDEV^PSGTI Q:POP D:'$D(IO("Q")) ENQ G EN
35 Q
36 ;
37ENQ ;
38 S Y="PSJPR" F X="W","WG" S:$D(PSJSEL(X)) @(Y_X)=+PSJSEL(X),@(Y_X_"N")=$P(PSJSEL(X),U,2)
39 S PSJACNWP=1 K ^TMP("PSJAT",$J) S PSJPR=IO'=IO(0)!($E(IOST)'="C"),PSGPRP=PSJPRP
40 I PSJSEL("SELECT")="P" S PPN="" F S PPN=$O(PSJSEL("P",PPN)) Q:PPN="" D Q:$G(X)?1"^"."^"
41 .F DFN=0:0 S (PSGP,DFN)=$O(PSJSEL("P",PPN,DFN)) Q:'DFN D ENBOTH^PSJAC,PP Q:$G(X)?1"^"."^"
42 D:PSJSEL("SELECT")'="P" @("P"_PSJSEL("SELECT")) I PSJPR W:$Y @IOF D ^%ZISC,DONE
43 Q
44PC ;
45 K ^TMP("PSJPR",$J,"OUTPAT")
46 S (STDTE,CLINIC,JDFN)=0
47 F S STDTE=$O(^PS(55,"AIVC",STDTE)) Q:STDTE="" F S CLINIC=$O(^PS(55,"AIVC",STDTE,CLINIC)) Q:CLINIC="" D
48 . F S JDFN=$O(^PS(55,"AIVC",STDTE,CLINIC,JDFN)) Q:JDFN="" I '$D(^TMP("PSJPR",$J,"OUTPAT",JDFN)) S DFN=JDFN K ^TMP("PSJAT",$J) D PAT,PAT1,PJ
49 S (STDTE,CLINIC,JDFN)=0
50 F S STDTE=$O(^PS(55,"AUDC",STDTE)) Q:STDTE="" F S CLINIC=$O(^PS(55,"AIVC",STDTE,CLINIC)) Q:CLINIC="" D
51 . F S JDFN=$O(^PS(55,"AUDC",STDTE,CLINIC,JDFN)) Q:JDFN="" I '$D(^TMP("PSJPR",$J,"OUTPAT",JDFN)) S DFN=JDFN K ^TMP("PSJAT",$J) D PAT,PAT1,PJ
52 Q
53 ;
54PJ ;
55 S ^TMP("PSJPR",$J,"OUTPAT",JDFN)=""
56 ;
57PG ;
58 F PSJPRW=0:0 S PSJPRW=$O(^PS(57.5,"AC",PSJPRWG,PSJPRW)) Q:'PSJPRW S PSJPRWN=$P($G(^DIC(42,+PSJPRW,0)),"^") I PSJPRWN]"" D PW Q:$G(X)="^"
59 Q
60 ;
61PW ;
62 K ^TMP("PSJAT",$J) F DFN=0:0 S (DFN,PSGP)=$O(^DPT("CN",PSJPRWN,DFN)) Q:'DFN D PAT
63 D PAT1
64 ;
65 Q
66 ;
67PAT ;
68 S RB=$P($G(^DPT(DFN,.101)),U),PPN=$P($G(^(0)),U),X=$S(PSJSEL("RBP")="R":RB,1:PPN),AT=""
69 I $D(PSJSEL("TM")) S:RB]"" AT=$O(^PS(57.7,"AWRT",PSJPRW,RB,0)) Q:$S($D(PSJSEL("TM","ALL")):0,AT="":1,1:'$D(PSJSEL("TM",AT)))
70 F Y="AT","RB","X" S:@Y="" @Y="ZZ"
71 S ^TMP("PSJAT",$J,AT,X,DFN)=""
72 Q
73 ;
74PAT1 ;
75 K PSJDBL S PSJAT="" F S PSJAT=$O(^TMP("PSJAT",$J,PSJAT)) Q:PSJAT=""!$G(PSJDBL) D
76 .S PSJPNRB="" F S PSJPNRB=$O(^TMP("PSJAT",$J,PSJAT,PSJPNRB)) Q:PSJPNRB="" S (DFN,PSGP)=+$O(^TMP("PSJAT",$J,PSJAT,PSJPNRB,0)) D ENBOTH^PSJAC,PP I $G(X)["^" S:X="^^" PSJDBL=1 Q
77 Q
78 ;
79PP ;
80 I PSJPRP'="E" D ^PSJO I PSJPRP="P",'PSJPR D:'PSJON READ^PSJUTL Q:$G(X)?1"^"."^" I PSJON S PSJPRF=1 D ENVW^PSJOE0 K PSGPRF Q
81 Q:PSJPRP="P" I PSJPRP="E" U IO S PSJON=0,PSJDEV=PSJPR D @$S($D(PSJEXTP):"EN^PSJH1,ENGET^PSJO3",1:"EN^PSJO1(3),ENGET^PSJO3")
82 I 'PSJPR,PSJSEL("SELECT")'="P",'$D(^TMP("PSG",$J)) D READ^PSJUTL Q
83 I PSJPRP'="E",'PSJPR D PP3 Q:$D(DUOUT)!$D(DTOUT)
84 S (PSJS1,PSJS2,PSJS3,PSJS4,X)=""
85 F PSJQ=0:0 S PSJS1=$O(^TMP("PSJ",$J,PSJS1)) Q:PSJS1="" F PSJQ=0:0 S PSJS2=$O(^TMP("PSJ",$J,PSJS1,PSJS2)) Q:PSJS2="" F PSJQ=0:0 S PSJS3=$O(^TMP("PSJ",$J,PSJS1,PSJS2,PSJS3)) Q:PSJS3="" D PP1
86 D:X'["^"&PSJPR BOT^PSJO3 K ^TMP("PSJ",$J) Q
87 ;
88PP1 ;
89 F PSJQ=0:0 S PSJS4=$O(^TMP("PSJ",$J,PSJS1,PSJS2,PSJS3,PSJS4)) Q:PSJS4="" D PP2
90 Q
91 ;
92PP2 ; Display selected order.
93 N PSJPRF,PSJLM S PSJORD=PSJS4 I $S(PSJORD["V":1,PSJORD["P":$P($G(^PS(53.1,+PSJORD,0)),U,4)="F",1:0) D Q
94 .S PSJPRF=1 D ENINP^PSIVOPT(PSGP,PSJORD),PP3 Q:$D(DUOUT)!$D(DTOUT) I PSJPRA'="N" I PSJORD'["P" D ENLOG^PSIVVW1,PP3 Q
95 S PSGORD=PSJORD D EN2^PSGVW,PP3 Q:$D(DUOUT)!$D(DTOUT) I PSJPRA'="N",((PSJS1["A")!(PSJS1["O")) S AT=PSJPRA D ENA^PSGVW0 D PP3
96 Q
97PP3 S X="" I 'PSJPR K DIR S DIR(0)="E" D ^DIR S:$D(DUOUT)!$D(DTOUT) X="^" I X["^" S (PSJS1,PSJS2,PSJS3,PSJS4)="~"
98 Q
99 ;
100PH ;
101 W !!?2,"Enter a 'P' to print ONLY the PROFILE of orders for this patient. Enter an",!,"'E' to print ONLY the EXPANDED VIEW of the orders for this patient. Enter a",!,"'B' to have BOTH the profile (first) and the expanded views print."
102 W " Enter an '^'to exit." Q
103 ;
104ENOR(PSGP) ;S (PSGP,DFN)=+ORVP,PSGP(0)=^DPT(PSGP,0)
105 S DFN=+PSGP,PSGP(0)=^DPT(PSGP,0)
106ENLM N PSJNEW,PSGPTMP,PPAGE S PSJNEW=1
107 S PSGPTMP=0,PPAGE=1
108 D ENCV^PSGSETU
109 D ENBOTH^PSJAC D:$D(PSJEXTP) CNV^PSJP D ENL^PSJO3 I "^N"'[PSJOL S PSJSEL("SELECT")="P",PSJSEL("P",PSGP(0),PSGP)="",(PSJPRW,PSJPRWG)=0,(PSJPRWN,PSJPRWGN)="",XQUIT="YES" D GO
110 ;* S PSJNKF=1 D READ^PSJUTL G DONE
111 S PSJNKF=1 G DONE
Note: See TracBrowser for help on using the repository browser.