source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPGET1.m@ 861

PPPGET1 ;ALB/DMB/DAD - PRESC. PRACT. GET ROUTINES ;10-AUG-93

 ;;1.0;PHARMACY PRESCRIPTION PRACTICE;**8,17,21,39**;APR 7,1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

GETDFN(PATIENT,VERBOSE) ;RETURN DFN OF PATIENT

 ;THIS WILL RETURN THE SAME INFORMATION THAT DIC RETURNS IN Y

 ;

 N DIC,X,Y,DTOUT,DUOUT,RESULT,USRABORT,DGSENFLG

 ;

 S DGSENFLG=""

 S USRABORT=-1001

 S:'$D(PATIENT) PATIENT=""

 S:'$D(VERBOSE) VERBOSE=0

 S VERBOSE=$S(VERBOSE:"E",1:"")

 ;

 ;USER INTERFACE

 S DIC(0)="M"_VERBOSE

 S:VERBOSE="" DIC(0)=DIC(0)_"X"

 I PATIENT="" D

 .S DIC(0)=DIC(0)_"AQ"

 S X=PATIENT

 S DIC=2

 D ^DIC

 ;

 ;USER ABORTED PROCESS

 ;

 I $D(DTOUT)!($D(DUOUT)) S RESULT=USRABORT

 E  S RESULT=Y

 ;

 Q RESULT

 ;

GETSNIFN(STATION,VERBOSE) ;RETURN IFN OF INSTITUTION

 ;THIS WILL RETURN THE SAME INFORMATION THAT DIC RETURNS IN Y

 ;

 N DIC,X,Y,DTOUT,DUOUT,RESULT,USRABORT

 ;

 S USRABORT=-1001

 S:'$D(STATION) STATION=""

 S:'$D(VERBOSE) VERBOSE=0

 S VERBOSE=$S(VERBOSE:"E",1:"")

 ;

 ;USER INTERFACE

 S DIC(0)="M"_VERBOSE

 I STATION="" D

 .S DIC(0)=DIC(0)_"AQ"

 E  D

 .S DIC(0)=DIC(0)_"X"

 S X=STATION

 S DIC=4

 D ^DIC

 ;

 ;USER ABORTED PROCESS

 ;

 I $D(DTOUT)!($D(DUOUT)) S RESULT=USRABORT

 E  S RESULT=Y

 ;

 Q RESULT

 ;

GETFFX(FFXIFN,TARRY) ; Get data from an FFX entry

 ;

 N DIC,DR,DA,DIQ,DUOUT,DTOUT,PARMERR,NODE0,NODE1,ARRAYTMP,TMPARRAY,FMERR

 ;

 S PARMERR=-9001

 S FMERR=-9002

 S TMPARRAY="ARRAYTMP"

 ;

 I '$D(FFXIFN) Q PARMERR

 I '$D(TARRY) Q PARMERR

 K @TMPARRAY

 ;

 ; Get the data from the entry

 ;

 S NODE0=$G(^PPP(1020.2,FFXIFN,0)) Q:$P(NODE0,"^")="" PARMERR

 S NODE1=$G(^PPP(1020.2,FFXIFN,1))

 ;

 ; Get the patient name and SSN from the patient file

 ;

 S DA=$P(NODE0,"^")

 I DA'="" D

 .S DR=".01;.09"

 .S DIC=2

 .S DIQ=TMPARRAY

 .S DIQ(0)="E"

 .D EN^DIQ1

 .I '$D(@TMPARRAY) Q FMERR

 .S @TARRY@(FFXIFN,"NAME")=$G(@TMPARRAY@(2,DA,.01,"E"))

 .S @TARRY@(FFXIFN,"SSN")=$G(@TMPARRAY@(2,DA,.09,"E"))

 .K @TMPARRAY

 E  D

 .S @TARRY@(FFXIFN,"NAME")="NOT AVAILABLE"

 .S @TARRY@(FFXIFN,"SSN")="NOT AVAILABLE"

 ;

 ; Get the institution info from file 4

 ;

 S DA=$P(NODE0,"^",2)

 I DA'="" D

 .;VMP OIFO BAY PINES;VGF;PPP*1.0*39

 .S DOMAIN=$$DOMAIN^PPPFMX(FFXIFN)

 .S LNUM=0 I DOMAIN]"" S LNUM=$O(^PPP(1020.128,"A",DOMAIN,0))

 .I LNUM S DOMAIN=$P(^PPP(1020.128,LNUM,0),"^",2)

 .S @TARRY@(FFXIFN,"STANO")=$$GETSTANO(DA)

 .S @TARRY@(FFXIFN,"POV")=$P(DOMAIN,".",1)

 .K @TMPARRAY

 E  D

 .S @TARRY@(FFXIFN,"POV")="NOT AVAILABLE"

 .S @TARRY@(FFXIFN,"STANO")="NOT AVAILABLE"

 ;

 ; Now fill in the rest of the data

 ;

 I $P(NODE0,"^",3)'="" D

 .S @TARRY@(FFXIFN,"LVD")=$$I2EDT^PPPCNV1($P(NODE0,"^",3))

 E  S @TARRY@(FFXIFN,"LVD")="NOT AVAILABLE"

 I $P(NODE1,"^",2)'="" D

 .S @TARRY@(FFXIFN,"LPDX")=$$I2EDT^PPPCNV1($P(NODE1,"^",2))

 E  S @TARRY@(FFXIFN,"LPDX")="NOT AVAILABLE"

 ;VMP OIFO BAY PINES;VGF;PPP*1.0*39

 I $G(DOMAIN)]"" D

 .S @TARRY@(FFXIFN,"DOMAIN")=$G(DOMAIN)

 E  S @TARRY@(FFXIFN,"DOMAIN")="NOT AVAILABLE"

 I $P(NODE1,"^",3)'="" D

 .S @TARRY@(FFXIFN,"STATUS")=$P($$GETPDXST^PPPGET7($P(NODE1,"^",3)),"^",2)

 E  S @TARRY@(FFXIFN,"STATUS")="NOT AVAILABLE"

 I $P(NODE1,"^",4)'="" D

 .S @TARRY@(FFXIFN,"LBRD")=$$I2EDT^PPPCNV1($P(NODE1,"^",4))

 E  S @TARRY@(FFXIFN,"LBRD")="NOT AVAILABLE"

 I $P(NODE0,"^",4)'="" D

 .S @TARRY@(FFXIFN,"SOURCE")=$S(($P(NODE0,"^",4)=1):"MANUAL",1:"AUTO")

 E  S @TARRY@(FFXIFN,"SOURCE")="NOT AVAILABLE"

 I $P(NODE0,"^",5)'="" D

 .S @TARRY@(FFXIFN,"ED")=$$I2EDT^PPPCNV1($P(NODE0,"^",5))

 E  S @TARRY@(FFXIFN,"ED")="NOT AVAILABLE"

 Q 0

 ;

GETFFIFN(PATDFN,SNIFN) ; Get the FFX ifn for a patient/station entry

 ;

 N PARMERR,FINDERR,FFIFN

 ;

 S PARMERR=-9001

 S FINDERR=-9003

 ;

 I '$D(PATDFN) K PPPSRT Q PARMERR

 I '$D(SNIFN) K PPPSRT Q PARMERR

 ;

 S FFIFN=$O(^PPP(1020.2,"APOV",PATDFN,SNIFN,""))

 I FFIFN'>0 Q FINDERR

 Q FFIFN

 ;

GETSSN(DFN) ;

 ;

 N DIC,DA,DR,DIQ,PPPTMP,SSN,DUOUT,DTOUT

 ;

 S DIC=2,DA=DFN,DR=".09",DIQ="PPPTMP",DIQ(0)="E"

 D EN^DIQ1

 S SSN=$G(PPPTMP(2,DFN,.09,"E"))

 I SSN="" Q -1

 Q SSN

 ;

GETSTANO(SNIFN) ;

 I $D(^DIC(4,"D",SNIFN)) S STANO=SNIFN Q STANO

 I $D(^PPP(1020.8,"B",SNIFN)) S STANO=SNIFN Q STANO

 ;

 N DIC,DA,DR,DIQ,PPPTMP,STANO

 ;

 S DIC=4,DA=SNIFN,DR="99",DIQ="PPPTMP",DIQ(0)="E"

 ;PPP*1*21

 D EN^DIQ1

 S STANO=$G(PPPTMP(4,SNIFN,99,"E"))

 I STANO="",$D(^PPP(1020.8,"B",SNIFN)) S STANO=SNIFN

 I STANO="" Q -1

 Q STANO

 ;

GETPATNM(DFN) ;

 ;

 N DIC,DA,DR,DIQ,PPPTMP,NAME

 ;

 S DIC=2,DA=DFN,DR=".01",DIQ="PPPTMP",DIQ(0)="E"

 D EN^DIQ1

 S NAME=$G(PPPTMP(2,DFN,.01,"E"))

 I NAME="" Q -1

 Q NAME

 ;

GETSTANM(SNIFN) ;

 ;

 N NAME

 ;VMP OIFO BAY PINES;VGF;PPP*1.0*39

 S SNIFN=$O(^PPP(1020.8,"B",SNIFN,""))

 I SNIFN="" Q -1

 S NAME=$P($G(^PPP(1020.8,SNIFN,0)),"^",2),NAME=$P(NAME,".",1)

 I NAME="" Q -1

 Q NAME