source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSONVAVW.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1PSONVAVW ;BHM/MFR - View Non-VA Med - Listmanager ;10/20/06
2 ;;7.0;OUTPATIENT PHARMACY;**260**;13 Feb 97;Build 84
3 ;Reference to File ^PS(55 supported by DBIA 2228
4 ;Reference to $$GET1^DIQ is supported by DBIA 2056
5 ;Reference to DEM^VADPT is supported by DBIA 10061
6 ;Reference to EN6^GMRVUTL is supported by DBIA 1120
7 ;
8EN(PSODFN,PSORD) ; - Entry point
9 N VALMCNT,VALMHDR
10 D EN^VALM("PSO NON-VA MEDS VIEW")
11 Q
12 ;
13HDR ; - Header
14 N LINE1,LINE2,LINE3,WT,WTDT,HT,HTDT,VADM,DFN,PNAME,DOB,SEX,X,VADM,WT,HT,GMRVST,GMRVSTR,DOB,PNAME,SEX
15 ;
16 K VADM S DFN=PSODFN D DEM^VADPT
17 S PNAME=VADM(1)
18 S DOB=$S(+VADM(3):$P(VADM(3),"^",2)_" ("_$G(VADM(4))_")",1:"UNKNOWN")
19 S SEX=$P(VADM(5),"^",2)
20 S (WT,X)="",GMRVSTR="WT" D EN6^GMRVUTL I X'="" S WT=$J($P(X,"^",8)/2.2,6,2),WTDT=$$DT($P(X,"^")\1)
21 S (HT,X)="",GMRVSTR="HT" D EN6^GMRVUTL I X'="" S HT=$J($P(X,"^",8)*2.54,6,2),HTDT=$$DT($P(X,"^")\1)
22 S LINE1=PNAME S LINE1=$$ALLERGY^PSOPMP1(LINE1,DFN,"")
23 S LINE2=" PID: "_$P(VADM(2),"^",2),$E(LINE2,50)="HEIGHT(cm): "_$S(HT'="":HT_" ("_HTDT_")",1:"NOT AVAILABLE")
24 S LINE3=" DOB: "_DOB,$E(LINE3,30)="SEX: "_SEX,$E(LINE3,50)="WEIGHT(kg): "_$S(WT'="":WT_" ("_WTDT_")",1:"NOT AVAILABLE")
25 ;
26 K VALMHDR S VALMHDR(1)=LINE1,VALMHDR(2)=LINE2,VALMHDR(3)=LINE3
27 ;
28 Q
29 ;
30INIT ;
31 N OINAM,DGNAM,CLNAM,LINE,NMSPC,L,DIWL,DIWR,X,I,OCK,PRV,STR,TXT,K,TXT,XX
32 S XX=^PS(55,PSODFN,"NVA",PSORD,0),OINAM=$$GET1^DIQ(50.7,+$P(XX,"^"),.01)
33 S DGNAM="" I $P(XX,"^",2) S DGNAM=$$GET1^DIQ(50,+$P(XX,"^",2),.01)
34 ;
35 S LINE=0,NMSPC="PSONVAVW" K ^TMP(NMSPC,$J)
36 S LINE=LINE+1,^TMP(NMSPC,$J,LINE,0)=$J("Non-VA Med: ",23)_OINAM
37 S LINE=LINE+1,^TMP(NMSPC,$J,LINE,0)=$J("Dispense Drug: ",23)_DGNAM
38 S LINE=LINE+1,^TMP(NMSPC,$J,LINE,0)=$J("Dosage: ",23)_$P(XX,"^",3)
39 ;
40 K ^UTILITY($J,"W")
41 S X=$$SCHED^PSONVNEW($$GET1^DIQ(55.05,PSORD_","_PSODFN,4)),DIWL=1,DIWR=60 D ^DIWP
42 F L=1:1 Q:'$D(^UTILITY($J,"W",1,L)) D
43 . S X="" S:L=1 X=$J("Schedule: ",23) S $E(X,24)=^UTILITY($J,"W",1,L,0)
44 . S LINE=LINE+1,^TMP(NMSPC,$J,LINE,0)=X
45 ;
46 S LINE=LINE+1,^TMP(NMSPC,$J,LINE,0)=$J("Med Route: ",23)_$P(XX,"^",4)
47 S LINE=LINE+1,^TMP(NMSPC,$J,LINE,0)=$J("Status: ",23)_$S('$P(XX,"^",6):"ACTIVE",1:"DISCONTINUED on "_$$DT($P(XX,"^",7)))
48 S LINE=LINE+1,^TMP(NMSPC,$J,LINE,0)=$J("CPRS Order #: ",23)_$P(XX,"^",8)
49 S LINE=LINE+1,^TMP(NMSPC,$J,LINE,0)=$J("Documented By: ",23)_$$GET1^DIQ(200,+$P(XX,"^",11),.01)
50 S LINE=LINE+1,^TMP(NMSPC,$J,LINE,0)=$J("Documented Date: ",23)_$$DT($P(XX,"^",10))
51 S CLNAM=$$GET1^DIQ(44,+$P(XX,"^",12),.01)
52 S LINE=LINE+1,^TMP(NMSPC,$J,LINE,0)=$J("Clinic: ",23)_$S($P(XX,"^",12):$P(XX,"^",12)_" - "_CLNAM,1:"")
53 S LINE=LINE+1,^TMP(NMSPC,$J,LINE,0)=$J("Start Date: ",23)_$$DT($P(XX,"^",9))
54 ;
55 ; - "Order Checks" fields
56 W:$D(^PS(55,PSODFN,"NVA",PSORD,"OCK")) !
57 F I=0:0 S I=$O(^PS(55,PSODFN,"NVA",PSORD,"OCK",I)) Q:'I D
58 . S OCK=^PS(55,PSODFN,"NVA",PSORD,"OCK",I,0),STR=$P(OCK,"^"),PRV=+$P(OCK,"^",2)
59 . K TXT D TEXT(.TXT,STR,61)
60 . D STXT(" Order Check #"_I_": ",.TXT)
61 . K TXT
62 . F J=0:0 S J=$O(^PS(55,PSODFN,"NVA",PSORD,"OCK",I,"OVR",J)) Q:'J D
63 . . S STR=^PS(55,PSODFN,"NVA",PSORD,"OCK",I,"OVR",J,0)
64 . . D TEXT(.TXT,STR,57)
65 . D STXT(" Override Reason: ",.TXT)
66 . S LINE=LINE+1,^TMP(NMSPC,$J,LINE,0)=" Override Provider: "_$S(PRV:$$GET1^DIQ(200,+PRV,.01),1:"")
67 ;
68 ; - "Statement/Explanation" field
69 I $D(^PS(55,PSODFN,"NVA",PSORD,"DSC")) D
70 . K TXT
71 . F I=0:0 S I=$O(^PS(55,PSODFN,"NVA",PSORD,"DSC",I)) Q:'I D
72 . . S STR=^PS(55,PSODFN,"NVA",PSORD,"DSC",I,0)
73 . . D TEXT(.TXT,STR,57)
74 . D STXT("Statement/Explanation: ",.TXT)
75 ;
76 ; - "Comments" field
77 I $D(^PS(55,PSODFN,"NVA",PSORD,1)) D
78 . K TXT
79 . F I=0:0 S I=$O(^PS(55,PSODFN,"NVA",PSORD,1,I)) Q:'I D
80 . . S STR=^PS(55,PSODFN,"NVA",PSORD,1,I,0)
81 . . D TEXT(.TXT,STR,57)
82 . D STXT(" Comments: ",.TXT)
83 ;
84 S VALMCNT=LINE
85 Q
86 ;
87TEXT(TEXT,STR,L) ; Formats STR into TEXT array, lines lenght = L
88 N J,WORD,K S K=+$O(TEXT(""),-1) S:'K K=1
89 F J=1:1:$L(STR," ") D
90 . S WORD=$P(STR," ",J) I ($L($G(TEXT(K))_WORD))>L S K=K+1
91 . S TEXT(K)=$G(TEXT(K))_WORD_" "
92 Q
93 ;
94STXT(LABEL,TXT) ; Sets text lines
95 N K,X
96 F K=1:1 Q:'$D(TXT(K)) D
97 . S X="" S:K=1 X=LABEL S $E(X,24)=TXT(K)
98 . S LINE=LINE+1,^TMP(NMSPC,$J,LINE,0)=X
99 Q
100 ;
101DT(DT) ; - Convert FM Date to MM/DD/YYYY
102 I 'DT Q ""
103 I '(DT#10000) Q (1700+$E(DT,1,3))
104 I '(DT#100) Q $E(DT,4,5)_"/"_(1700+$E(DT,1,3))
105 Q $E(DT,4,5)_"/"_$E(DT,6,7)_"/"_(1700+$E(DT,1,3))
106 ;
107EXIT Q
108 ;
109HELP Q
Note: See TracBrowser for help on using the repository browser.