source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOPKIV1.m@ 631

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1PSOPKIV1 ;BHAM ISC/MHA - validate PKI cert. ; 05/09/2002 8:15 am
2 ;;7.0;OUTPATIENT PHARMACY;**131,146,223,148,249**;DEC 1997;Build 9
3 ;Ref. to ^ORWOR1 supported by DBIA 3750
4CER ;
5 N P1,P2
6 I $D(OR0) S P1=$P(OR0,"^"),P2=$P(OR0,"^",2)
7 E S P1=$P($G(^PSRX(DA,"OR1")),"^",2),P2=$P($G(^(0)),"^",2)
8 I P1<1 S PKI=-1,VALMSG="Invalid CPRS Pointer - Unable to Process" Q
9CT N PKIRT D VERIFY^ORWOR1(.PKIRT,P1,P2)
10 S PKI=+PKIRT I PKI=1 S VALMSG="Digitally Signed Order",PKIE="Processing "_VALMSG Q
11 I PKI<2 S VALMSG=$P(PKIRT,"^",2) Q
12 S PKI1=$S(PKI>89802014&(PKI<89802019)!((PKI>89802020)&(PKI<89802023)):2,1:1)
13 S PKIE="Digital Signature Failed: "_$P($T(@($E(PKI,7,8))),";;",2)
14 S:'$G(PSOZVER) VALMSG="Signature Failed: "_$P($T(@($E(PKI,7,8))),";;",2)
15 S:PKI1=2 PKIE=PKIE_" - Order Auto Discontinued" S:$L(PKIE)>75 PKIE=$E(PKIE,1,75)
16 Q
17L1 ;
18 S PKID=1,IEN=IEN+1,^TMP($S($G(ST)=1:"PSOAO",1:"PSOPO"),$J,IEN,0)=PKIE Q
19ERR(ER) ;
20 Q:'ER
21 N ERM S ERM=$P($T(@($E(ER,7,8))),";;",2) I ERM]"" Q "Signature Failed: "_ERM
22 Q ""
23REA ;
24 D KV^PSOVER1
25 W ! S DIR("A")="Enter Override Reason ",DIR(0)="F^5:70",DIR("?")="Free text reason must be entered, should be between 5 to 70 characters and must not contain embedded up-arrow, e.g. Spoke with the Provider."
26 S:$G(PKIR)]"" DIR("B")=PKIR D ^DIR S:'$D(DIRUT) PKIR=Y
27 I $D(DIRUT) K PKIR I $D(OR0) S:$P(OR0,"^",3)="RNW" PSONEW("QFLG")=1 S:$P(OR0,"^",3)="NW" PSORX("DFLG")=1
28 D KV^PSOVER1 K Y Q
29ACT(DA) ;
30 Q:'DA
31 N I,J D AR
32 S ^PSRX(DA,"A",0)="^52.3DA^"_J_"^"_J,^PSRX(DA,"A",J,0)=%_"^K^"_DUZ_"^0^INVALID PKI CERT. "_PKI
33 S ^PSRX(DA,"A",J,2,1,0)=PKIR,^PSRX(DA,"A",J,2,0)="^52.34A^1^1"
34 K PKIR Q
35 ;
36AR ;
37 S (I,J)=0 F S I=$O(^PSRX(DA,"A",I)) Q:'I S J=I
38 S J=J+1 D NOW^%DTC Q
39DCP ;
40 Q:'$D(^PS(52.41,ORD,0))
41 K ^PS(52.41,"AOR",$P(^PS(52.41,ORD,0),"^",2),+$P($G(^PS(52.41,ORD,"INI")),"^"),ORD),^PS(52.41,"AD",$P(^PS(52.41,ORD,0),"^",12),+$P($G(^PS(52.41,ORD,"INI")),"^"),ORD)
42 S $P(^PS(52.41,ORD,0),"^",3)="DC"
43 S PKIE=$P(PKIE," - ")_" - "_PKI,$P(^PS(52.41,ORD,4),"^")=PKIE
44 D EN^PSOHLSN($P(^PS(52.41,ORD,0),"^"),"OD",PKIE,"A")
45 Q
46 ;
47DCV ;
48 W ! D KV^PSOVER1 K PKIR S DIR(0)="Y",DIR("B")="N",DIR("A",1)="Digitally signed Schedule II Rx cannot be deleted, it can only be D/Ced."
49 S DIR("A")="Are you sure you want to D/C this Rx: " D ^DIR,KV^PSOVER1
50 I 'Y S VALMSG="No Action Taken!",VALMBCK="R" Q
51 S:'$D(INCOM) INCOM="DCed by Pharmacy for PKI" S DIR("B")=INCOM
52 ;
53 W ! S DIR("A")="Reason for D/Cing",DIR(0)="F^5:75",DIR("?")="Reason must be entered and should be 5 to 75 characters and must not contain embedded uparrow"
54 D ^DIR I $D(DIRUT) D KV^PSOVER1 S VALMSG="No Action Taken!",VALMBCK="R" Q
55 S PKIR=Y D KV^PSOVER1
56DCV0 Q:'$D(^PS(52.4,DA,0))
57 S $P(^PSRX(DA,"STA"),"^")=12,$P(^PSRX(DA,3),"^",5)=DT
58 D REVERSE^PSOBPSU1(DA,,"DC",7),CAN^PSOTPCAN(DA) N I,J D AR
59 S ^PSRX(DA,"A",J,0)=%_"^C^"_DUZ_"^0^Discontinued during verification"
60 S J=J+1 D ADR
61 N PKIX S PKIX=DA D EN^PSOHLSN1(DA,"OD","",PKIR,PSONOOR)
62 S DA=PKIX S DIK="^PS(52.4," D ^DIK K DIK
63 Q
64 ;
65DCV1 N PKIR,PSONOOR,DA S DA=PSONV,PKIR=$P($G(PKIE),"-")_" - "_PKI,PSONOOR="A" D DCV0
66 Q
67ADR ;
68 S ^PSRX(DA,"A",0)="^52.3DA^"_J_"^"_J
69 S ^PSRX(DA,"A",J,0)=%_"^K^"_DUZ_"^0^Digitally signed"
70 S ^PSRX(DA,"A",J,2,1,0)=$S($G(PKIR)]"":PKIR,1:"Digitally signed order Discontinued"),^PSRX(DA,"A",J,2,0)="^52.34A^1^1"
71 Q
72RV ;
73 N TY,T,T1,T2,MIG,SG
74 S (T,T2)=0
75 F S T=$O(^PS(52.41,ORD,"OBX",T)) Q:'T D
76 .S T1=0,$P(TY(T2)," ",23)=" "
77 .F S T1=$O(^PS(52.41,ORD,"OBX",T,2,T1)) Q:'T1 D
78 ..S MIG=^PS(52.41,ORD,"OBX",T,2,T1,0)
79 ..F SG=1:1:$L(MIG," ") S:$L(TY(T2)_" "_$P(MIG," ",SG))>80 T2=T2+1,$P(TY(T2)," ",23)=" " S TY(T2)=$G(TY(T2))_" "_$P(MIG," ",SG)
80 .S T2=T2+4
81 S T2=T2+2 D CNTRL^VALM10(T2,1,$L(PKIE),IORVON,IORVOFF,0)
82 Q
83 ;
8400 ;;Order Text is blank;;
8501 ;;DEA # missing;;
8602 ;;Drug Schedule missing;;
8703 ;;DEA # not valid;;
8804 ;;Valid Certificate not found;;
8905 ;;Couldn't load CSP;;
9006 ;;Smart card Reader not found;;
9107 ;;Certificate with DEA # not found;;
9208 ;;Certificate not valid for schedule;;
9310 ;;Crypto Error (contact IRM);;
9415 ;;Corrupted (Decode failure);;
9516 ;;Corrupted (Hash mismatch);;
9617 ;;Certificate revoked;;
9718 ;;Verification failure;;
9819 ;;Before Cert effective date;;
9920 ;;Certificate expired;;
10021 ;;No Cert with a valid date found;;
10122 ;;Signature Check failed (Invalid Signature);;
Note: See TracBrowser for help on using the repository browser.