source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSCPRS.m@ 1639

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1PSSCPRS ;BIR/ASJ-API for CPRS ;09/07/00
2 ;;1.0;PHARMACY DATA MANAGEMENT;**38**;9/30/97
3 ;Reference to $$CPRS^PSNAPIS supported by DBIA 2531
4 ;
5 ; PSDD -Dispense Drug, PSOI-Orderable Item, PSPK-Package
6 ; PSDOS-Dosage, PSDUD-Dispense Units per Dosage
7 ;RESULT(1)=Dispense Drug^Dosage^Orderable Item^Dispense Units per Dosage
8 ;RESULT(2)=ERROR DESCRIPTION
9CPRS(PSSAR) ;
10 N AA,BB,FLAG,PDOS,PDS,POSDOS,PSCORR,PSDOS1,PSDPD,PSDUPD,PSLI,PSMARK,PSND,PSNDSTR,PSNDUN,PSNODE2,PSOD,PSSND1,PSSND3,PSSNDF,PSSOP,PSSTR,PSUNT,PSNODE,PSUSE,PSDD,PSOI,PSDOS,PSDUD,PSPK,PSNODE8,X
11 K RESULTS S RESULT(0)=-1,(FLAG,PSMARK)=0,U="^"
12 S PSDD=$G(PSSAR("DRUG")),PSOI=$G(PSSAR("ITEM")),PSPK=$G(PSSAR("PACK"))
13 S PSDOS=$G(PSSAR("DOSAGE")),PSDUD=$G(PSSAR("DUPD"))
14 I 'PSDD!('PSOI) Q
15 S PSNODE=$G(^PSDRUG(+PSDD,0)),PSUSE=$P($G(^(2)),U,3),PSNODE8=$G(^(8))
16 S PSSNDF=$G(^PSDRUG(+PSDD,"ND")),PSSND1=$P(PSSNDF,U),PSSND3=$P(PSSNDF,U,3)
17 G:PSPK="I" ^PSSCPRS1 G:+PSDUD>0 ND
18 I 'PSSND1!('PSSND3) S RESULT(0)=-1,RESULT(2)="Problem in ND node!" Q
19 S X=$$DFSU^PSNAPIS(PSSND1,PSSND3) I $P(X,U,4)="" D NNSI Q
20 I $P(X,U)'="" D NNMI
21 Q
22ND ; O/P to I/P Transfer Rules - Numeric Dosages
23 ;
24FR571 I '$P($G(^PSDRUG(+PSDD,"I")),"^")!($P($G(^("I")),"^")'<DT),(PSUSE["U") S RESULT(0)=1,RESULT(1)=PSDD_"^"_PSDOS,RESULT(2)="FR571" Q
25 ;
26FR572 S PSCORR=$P(PSNODE8,U,6) I PSCORR I '$P($G(^PSDRUG(PSCORR,"I")),"^")!($P($G(^("I")),"^")'<DT) S PSNODE2=$G(^PSDRUG(PSCORR,2)) D CP D
27 .F PDS=0:0 S PDS=$O(^PSDRUG(PSCORR,"DOS1",PDS)) Q:'PDS D
28 ..S PSDOS1=^PSDRUG(PSCORR,"DOS1",PDS,0)
29 ..I PSDOS'="",$P(PSDOS1,U,2)=PSDOS,($P(PSNODE2,U,3)["U")&($P(PSDOS1,U,3)["I") D
30 ...I $P(X,U,4)=$P(PSDOSN,U,2),$P(X1,U)=$P(X,U) S RESULT(0)=1,RESULT(1)=PSCORR_"^"_PSDOS,RESULT(2)="FR572" Q
31 Q:RESULT(0)=1
32 ;
33FR573 S AA=0 F S AA=$O(^PSDRUG("ASP",+PSOI,AA)) Q:'AA D
34 .I $D(^PSDRUG(AA,"DOS1",0)) F PDS=0:0 S PDS=$O(^PSDRUG(AA,"DOS1",PDS)) Q:'PDS D
35 ..S BB=^PSDRUG(AA,"DOS1",PDS,0),PSNODE2=$G(^PSDRUG(AA,2))
36 ..I PSDOS'="",$P(BB,U,2)=PSDOS,($P(PSNODE2,U,3)["U")&($P(BB,U,3)["I") S FLAG=1,PSLI(AA)=""
37 ;
38 I FLAG S AA=0 F S AA=$O(PSLI(AA)) Q:'AA F PDS=0:0 S PDS=$O(^PSDRUG(AA,"DOS1",PDS)) Q:'PDS D
39 .S POSDOS=^PSDRUG(AA,"DOS1",PDS,0) S PSDPD=+$P(POSDOS,U)
40 .I '$D(PSDUPD)!(PSDPD<PSDUPD) S PSDUPD=PSDPD
41 I FLAG S RESULT(0)=1,RESULT(1)=AA_"^"_$P(POSDOS,U,2),RESULT(2)="FR573",FLAG=0 Q
42 ;
43FR574 S PSCORR=$P(PSNODE8,U,6) I PSCORR I '$P($G(^PSDRUG(PSCORR,"I")),"^")!($P($G(^("I")),"^")'<DT) D CP D
44 .I $P(X,U,4)=$P(PSDOSN,U,2),$P(X1,U)=$P(X,U) S RESULT(0)=1,RESULT(1)=PSDD,RESULT(2)="FR574"
45 Q:RESULT(0)=1
46 ;
47FR575 S RESULT(0)=-1,RESULT(2)="All Numeric Dosage Rules failed!"
48 Q
49 ;
50NNSI ; O/P to I/P Transfer Rules- NON-NUMERIC Single Ingredient
51FR581 I '$P($G(^PSDRUG(+PSDD,"I")),"^")!($P($G(^("I")),"^")'<DT),(PSUSE["U")&(PSUSE["O") S RESULT(0)=1,RESULT(1)=PSDD_"^"_PSDOS_"^"_PSOI_"^"_PSDUD,RESULT(2)="FR581" Q
52 ;
53FR582 I (PSUSE'["U")&(PSUSE'["O") S PSCORR=$P(PSNODE8,U,6) I PSCORR I '$P($G(^PSDRUG(PSCORR,"I")),"^")!($P($G(^("I")),"^")'<DT) D CP D Q:RESULT(0)=1
54 .S PDOS=$G(^PSDRUG(PSCORR,"DOS")),PSSTR=$P(PDOS,U),PSUNT=$P(PDOS,U,2)
55 .I (PSSTR'="")&(PSUNT'=""),(PSSTR=PSNDSTR&(PSUNT=PSNDUN)) D
56 ..I $P(X,U,4)=$P(PSDOSN,U,2),$P(X1,U)=$P(X,U) S RESULT(0)=1,RESULT(1)=PSCORR_"^"_PSDOS_"^"_PSOI_"^"_PSDUD,RESULT(2)="FR582"
57 ;
58FR583 S AA=0 F S AA=$O(^PSDRUG("ASP",+PSOI,AA)) Q:'AA D
59 .S PSSTR=$P($G(^PSDRUG(AA,"DOS")),U),PSUNT=$P($G(^("DOS")),U,2)
60 .S X=$$CPRS^PSNAPIS(PSSND1,PSSND3) S PSNDSTR=$P(X,U,3),PSNDUN=$P(X,U,4)
61 .I (PSSTR'="")&(PSUNT'=""),(PSSTR=PSNDSTR)&(PSUNT=PSNDUN) S RESULT(0)=1,RESULT(1)=AA_"^"_PSDOS_"^"_PSOI_"^"_PSDUD,RESULT(2)="FR583"
62 Q:RESULT(0)=1
63FR584 S RESULT(0)=-1
64 Q
65 ;
66NNMI ; O/P to I/P Transfer Rules- Multi-Ingredient
67 ;
68FR591 I '$P($G(^PSDRUG(+PSDD,"I")),"^")!($P($G(^("I")),"^")'<DT),(PSUSE["U")&(PSUSE["O") S RESULT(0)=1,RESULT(1)=PSDD_"^"_PSDOS_"^"_PSOI_"^"_PSDUD,RESULT(2)="FR591" Q
69 ;
70FR592 I (PSUSE'["U")&(PSUSE'["O") S PSCORR=$P(PSNODE8,U,6) I PSCORR I '$P($G(^PSDRUG(PSCORR,"I")),"^")!($P($G(^("I")),"^")'<DT) D CP D
71 .I $P(X,U,4)=$P(PSDOSN,U,2),$P(X1,U)=$P(X,U) S RESULT(0)=1,RESULT(1)=PSCORR_"^"_PSOD_"^"_PSSOP_"^"_PSDUD,RESULT(2)="FR592"
72 Q
73 ;
74CP S PSND=$G(^PSDRUG(PSCORR,"ND")) S X=$$CPRS^PSNAPIS($P(PSND,"^"),$P(PSND,"^",3)),PSNDSTR=$P(X,U,3),PSNDUN=$P(X,U,4)
75 S PSDOSN=$G(^PSDRUG(PSDD,"DOS")),X1=$$CPRS^PSNAPIS(PSSND1,PSSND3)
76 Q
Note: See TracBrowser for help on using the repository browser.