Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOERX1E

PSOERX1E.m

Go to the documentation of this file.
PSOERX1E ;ALB/JSG - eRx Utilities ; 11/27/2019 11:02am
 ;;7.0;OUTPATIENT PHARMACY;**581**;DEC 1997;Build 126
 ;
PHCHREQ(PSOIEN,RULE,LINE,PRTVIEW) ; Pharmacy Change Request Note
 S PRTVIEW=+$G(PRTVIEW)
 N I,NEWRXNOT,NOTEARY,PHCHRQNT,RELERX,RELHUB,REQIEN
 S REQIEN=$S(RULE?1(1"1059",1"1060",1"1062".E):$$RESOLV^PSOERXU2(PSOIEN),1:PSOIEN)
 S RELHUB=$$GET1^DIQ(52.49,REQIEN,.14)
 S RELERX=$O(^PS(52.49,"FMID",RELHUB,0))
 S PHCHRQNT=$$GET1^DIQ(52.49,REQIEN,8,"I")
 S NEWRXNOT=$$GET1^DIQ(52.49,RELERX,8,"I")
 S:NEWRXNOT=PHCHRQNT PHCHRQNT=""
 I 'PRTVIEW D
 .S LINE=LINE+1 D SET^VALM10(LINE,"")
 .S LINE=LINE+1 D SET^VALM10(LINE,"Pharmacy Change Request Note: ")
 .I PHCHRQNT]"" D
 ..K NOTEARY
 ..D TXT2ARY^PSOERXD1(.NOTEARY,PHCHRQNT," ",80)
 ..S I=0 F  S I=$O(NOTEARY(I)) Q:'I  D
 ...S LINE=LINE+1 D SET^VALM10(LINE,NOTEARY(I))
 .I PHCHRQNT="" D
 ..S LINE=LINE+1 D SET^VALM10(LINE,PHCHRQNT)
 I PRTVIEW D
 .W !!,"Pharmacy Change Request Note: "
 .W !,PHCHRQNT
 Q