| 1 | PPPGET3 ;ALB/DMB/DAD - MISC GET ROUTINES ; 3/4/92
|
|---|
| 2 | ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**8,17,21**;APR 7,1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | GETUCI(GLOBAL) ; Returns the UCI & Volume for the requested global
|
|---|
| 6 | ; as ["UCI","VOL"]
|
|---|
| 7 | ; GLOBAL = "DPT" gets DPT, "TMP" gets TMP
|
|---|
| 8 | ;
|
|---|
| 9 | N Y
|
|---|
| 10 | Q:$S($G(GLOBAL)="DPT":0,$G(GLOBAL)="TMP":0,1:1) ""
|
|---|
| 11 | S:GLOBAL="DPT" Y=$P($G(^PPP(1020.1,1,1)),"^")
|
|---|
| 12 | S:GLOBAL="TMP" Y=$P($G(^PPP(1020.1,1,1)),"^",2)
|
|---|
| 13 | Q "["""_$E(Y,1,3)_""","""_$E(Y,5,7)_"""]"
|
|---|
| 14 | ;
|
|---|
| 15 | GETDOM(SNIFN) ; Returns the network address for institution
|
|---|
| 16 | ;
|
|---|
| 17 | N DOMIFN,DOMNM
|
|---|
| 18 | ;
|
|---|
| 19 | ;DAVE B (PPP*1*17 29OCT98)
|
|---|
| 20 | ;old way relied on dinummed valued pointer to domain file
|
|---|
| 21 | ;
|
|---|
| 22 | I $D(^PPP(1020.8,"D",SNIFN)) S SITEIEN=$O(^PPP(1020.8,"D",SNIFN,0)),DOMNM=$P($G(^PPP(1020.8,SITEIEN,0)),"^",2) G DMN
|
|---|
| 23 | I $D(^PPP(1020.8,SNIFN)) S DOMNM=$P($G(^PPP(1020.8,SNIFN,0)),"^",2)
|
|---|
| 24 | ;
|
|---|
| 25 | DMN S DOMNM=$G(DOMNM) I $G(DOMNM)="" S DOMNN=" " Q DOMNM
|
|---|
| 26 | S LNUM=0 I $G(DOMNM)]"" S LNUM=$O(^PPP(1020.8,"A",DOMNM,0))
|
|---|
| 27 | I LNUM S DOMNM=$P(^PPP(1020.128,LNUM,0),"^",2)
|
|---|
| 28 | Q DOMNM
|
|---|
| 29 | ;
|
|---|
| 30 | GETXREF() ; Gets patient for edit from FF Xref file or adds new from
|
|---|
| 31 | ; Pateint file
|
|---|
| 32 | ;
|
|---|
| 33 | N PPPPOP,USRABORT,DIR,DIRUT,RESULT
|
|---|
| 34 | ;
|
|---|
| 35 | S USRABORT=-1001,PPPPOP=0
|
|---|
| 36 | S DIR("A")="Select Patient Name"
|
|---|
| 37 | S DIR(0)="P^1020.2:EQMZL"
|
|---|
| 38 | W ! D ^DIR
|
|---|
| 39 | ;
|
|---|
| 40 | I $D(DIRUT) S RESULT=USRABORT
|
|---|
| 41 | E S RESULT=Y
|
|---|
| 42 | ;
|
|---|
| 43 | W !,"RESULT = ",RESULT
|
|---|
| 44 | Q RESULT
|
|---|
| 45 | ;
|
|---|
| 46 | GETINST() ; Gets Institution
|
|---|
| 47 | ;
|
|---|
| 48 | N PPPPOP,USRABORT,DIR,DIRUT,RESULT
|
|---|
| 49 | ;
|
|---|
| 50 | S USRABORT=-1001,PPPPOP=0
|
|---|
| 51 | S DIR("A")="Select Institution Name: "
|
|---|
| 52 | S DIR(0)="FAO^1:30^K:(X'=$C(32)&($L(X)<3)) X"
|
|---|
| 53 | S DIR("?")="^D HLPINST1^PPPHLP01"
|
|---|
| 54 | S DIR("??")="^D HLPI1^PPPHLP01"
|
|---|
| 55 | W ! D ^DIR
|
|---|
| 56 | ;
|
|---|
| 57 | I $D(DIRUT) S RESULT=USRABORT
|
|---|
| 58 | E S RESULT=Y
|
|---|
| 59 | ;
|
|---|
| 60 | Q RESULT
|
|---|
| 61 | ;
|
|---|
| 62 | GETSNIFN(STATION,VERBOSE) ;RETURN IFN OF INSTITUTION
|
|---|
| 63 | ;THIS WILL RETURN THE SAME INFORMATION THAT DIC RETURNS IN Y
|
|---|
| 64 | ;
|
|---|
| 65 | N DIC,X,Y,DTOUT,DUOUT,RESULT,USRABORT
|
|---|
| 66 | ;
|
|---|
| 67 | S USRABORT=-1001
|
|---|
| 68 | S:'$D(STATION) STATION=""
|
|---|
| 69 | S:'$D(VERBOSE) VERBOSE=0
|
|---|
| 70 | S VERBOSE=$S(VERBOSE:"E",1:"")
|
|---|
| 71 | ;
|
|---|
| 72 | ;USER INTERFACE
|
|---|
| 73 | S DIC(0)="M"_VERBOSE
|
|---|
| 74 | I STATION="" D
|
|---|
| 75 | .S DIC(0)=DIC(0)_"AQ"
|
|---|
| 76 | S X=STATION
|
|---|
| 77 | S DIC=4
|
|---|
| 78 | D ^DIC
|
|---|
| 79 | ;
|
|---|
| 80 | ;USER ABORTED PROCESS
|
|---|
| 81 | ;
|
|---|
| 82 | I $D(DTOUT)!($D(DUOUT)) S RESULT=USRABORT
|
|---|
| 83 | E S RESULT=Y
|
|---|
| 84 | ;
|
|---|
| 85 | Q RESULT
|
|---|
| 86 | ;
|
|---|
| 87 | GETDOMNM(SNIFN) ; -- gets Domain name from DOMAIN file (4.2)
|
|---|
| 88 | ;
|
|---|
| 89 | ; SNIFN = pointer to domain file
|
|---|
| 90 | ;
|
|---|
| 91 | Q:SNIFN'?1N.N SNIFN
|
|---|
| 92 | ;
|
|---|
| 93 | N DIC,DA,DR,DIQ,PPPTMP,NAME
|
|---|
| 94 | ;
|
|---|
| 95 | I $D(^PPP(1020.8,"B",SNIFN)) S PPPIEN=$O(^PPP(1020.8,"B",SNIFN,0)),NAME=$P($G(^PPP(1020.8,PPPIEN,0)),"^",2)
|
|---|
| 96 | S LNUM=0 I $G(NAME)]"" S LNUM=$O(^PPP(1020.128,"A",NAME,0))
|
|---|
| 97 | I LNUM S NAME=$P(^PPP(1020.128,LNUM,0),"^",2),DMNNEW=$G(DMNNEW)+1
|
|---|
| 98 | ;
|
|---|
| 99 | Q $G(NAME)
|
|---|
