source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPSAPI.m

RAPSAPI ;HOIFO/SWM-calling Pharmacy APIs ;8/29/05  08:12
        ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8
        ;
        ;DBIA: 4533  DATA^PSS50 returns external value of field from file #50
        ;DBIA: 4533  ZERO^PSS50 returns B crossreference of file #50
        ;DBIA: 4551  DO^PSSDI puts header info from file #50 into local vars
        ;DBIA: 4551 ($$FNAME^PSSDI) returns field value from file #50
        ;DBIA: 4551  DIC^PSSDI  looks up & screens records from file #50
        ;DBIA: 2055  reference to ROOT^DILFD
        Q
EN1(RAX,RAN)    ; call data^pss50 to get external values to some fields
        ; input RAX is ien to file 50
        ; input RAN is field number of file 50 to display
        N RAY,X,SCR
        S:RAX="" RAX=+RAX
        K ^TMP($J,"RAPSS50")
        D DATA^PSS50(RAX,"","","","","RAPSS50")
        S RAY=$G(^TMP($J,"RAPSS50",RAX,RAN))
        K ^TMP($J,"RAPSS50")
        Q RAY
EN2(RADIC,RAUTIL)       ; adapted from EN1^RASELCT
        ; called from selradio+11^RANMUTL1
        ;REQUIRES:
        ;  RADIC      = FILE NUMBER OR GLOBAL ROOT
        ;  RADIC(0)   = DIC(0) STRING
        ;  RAUTIL     = NODE TO STORE DATA UNDER IN ^TMP($J,RAUTIL,
        ;  RAVACL()   = ARRAY OF VA CLASS DRUGS TO INCLUDE
        ;  RAVACL("R") = INDICATE RADIOPHARMS ONLY
        ;OPTIONAL:
        ;  RADIC("A") = DIC("A") STRING
        ;  RADIC("S") is not accepted by DIC^PSSDI
        ;
        ;RETURNS:
        ;  1) RAQUIT     = $S(UP_ARROW_OUT:1 , NOTHING_SELECTED:1 , 1:0)
        ;  2) ^TMP($J,RAUTIL,EXTERNAL_.01_FIELD_DATA,IEN) = ""
        ;
        S RAQUIT=0
        I ($G(RADIC)="")!($G(RADIC(0))="")!($G(RAUTIL)="") S RAQUIT=1 G EXIT
        N DIC,PSSDIY,X,Y
        D K S DIC=RADIC I DIC S (RADIC,DIC)=$$ROOT^DILFD(DIC) I DIC="" S RAQUIT=1 G EXIT
        S DIC(0)=RADIC(0),DIC(0)=$TR(DIC(0),"AL") S:DIC(0)'["Z" DIC(0)=DIC(0)_"Z" S RADIC(0)=DIC(0)
        D DO^PSSDI(50,"RA",.RADIC)
        I PSSDIY=-1 S RAQUIT=1 G EXIT  ; -1 if file access invalid
        S RAFNAME=$P(DO,"^"),RAFLD01=$$FNAME^PSSDI(.01,50) K DO
        S RANUM=1 K ^TMP($J,RAUTIL) D HOME^%ZIS
1       ;
        W !!,$S(RANUM>1:"Another one (Select/De-Select): ",1:RADIC("A"))
        R X:DTIME S:('$T)!($E(X)="^") RAQUIT=1 G:RAQUIT EXIT G:X="" EXIT S RADSEL=$S(X?1"-"1.E:1,1:0) S:RADSEL X=$E(X,2,$L(X))
        I $L(X),(X["*") D SOME G 1
        ;removed checking for ALL because user answered "N" to all in selradio^ranmutl1
        D HELP:$E(X)="?"
        ; cannot call old SEL() to prevent reselection since can't use DIC("S")
        ; but no problem as same drug is stored only once in ^TMP
        ;
        ; null 6th piece skip check drug inactive dt -- want select old drugs
        D SETVACL^RAPSAPI2("R")
        D DIC^PSSDI(50,"RA",.RADIC,.X,"","","",.RAVACL)
        G:+Y'>0 1
        ; no rafld
        I 'RADSEL,'$D(^TMP($J,RAUTIL,$E($P(Y,U,2),1,63),+Y)) S ^(+Y)="",RANUM=RANUM+1
        I RADSEL,$D(^TMP($J,RAUTIL,$E($P(Y,U,2),1,63),+Y)) K ^(+Y) S RANUM=RANUM-$S(RANUM>0:1,1:0)
        G 1
EXIT    ;
         S RAQUIT=$S(RAQUIT:1,$O(^TMP($J,RAUTIL,""))="":1,1:0) K RADIC,RAUTIL
K       K %,%X,%Y,%Z,C,D0,DA,DIC,DIK,DIR,DO,RA,RAALL,RACASE,RAD0,RADSEL,RAFLD01
        K RAFNAME,RAFNUM,RAFSCR,RALINE,RANUM,RAVALUE,X,Y,RAVACL
        Q
SOME    ; SG 4/12/07
        N RA50I,RADIC0,RAENTRY,RAXN,NAME
        I $E(X,$L(X))'="*" W " ??",$C(7) Q
        I $L(X)=1 W "  ?? Enter at least 1 character before the ""*"".",$C(7) Q
        S RADIC0=RADIC(0),RADIC(0)="" ; no terminal output
        S RAENTRY=$E(X,1,$L(X)-1)
        D ZERO^PSS50(,RAENTRY,,,,"RAPSS50")
        S RAXN=""
        F  S RAXN=$O(^TMP($J,"RAPSS50","B",RAXN)) Q:RAXN=""  D
        . S RA50I=0
        . F  S RA50I=$O(^TMP($J,"RAPSS50","B",RAXN,RA50I))  Q:RA50I'>0  D
        . . ; screen data
        . . D SETVACL^RAPSAPI2("R")
        . . D DIC^PSSDI(50,"RA",.RADIC,"`"_RA50I,,,,.RAVACL)
        . . Q:+Y'>0
        . . S NAME=$E($P(Y,U,2),1,63)
        . . ; add
        . . I 'RADSEL D:'$D(^TMP($J,RAUTIL,NAME,+Y))  Q
        . . . S ^TMP($J,RAUTIL,NAME,+Y)="",RANUM=RANUM+1
        . . ; remove
        . . I $D(^TMP($J,RAUTIL,NAME,+Y)) K ^(+Y) S:RANUM>0 RANUM=RANUM-1
        S RADIC(0)=RADIC0
        K ^TMP($J,"RAPSS50")
        Q
HELP    ;
        N X S RA="Select a "_RAFNAME_" "_RAFLD01_" from the displayed list." D WRAP
        W !?5,"To deselect a ",RAFLD01," type a minus sign (-)",!?5,"in front of it, e.g.,  -",RAFLD01,"."
        W !?5,"Use an asterisk (*) to do a wildcard selection, e.g.,"
        W !?5,"enter ",RAFLD01,"* to select all entries that begin"
        W !?5,"with the text '",RAFLD01,"'.  Wildcard selection is"
        W !?5,"case sensitive."
        G:$O(^TMP($J,RAUTIL,""))="" HLP
SHOW    S RALINE=$Y,RA="" W !!,"You have already selected:"
        F  S RA=$O(^TMP($J,RAUTIL,RA)) Q:RA=""!RAQUIT  F RAD0=0:0 S RAD0=$O(^TMP($J,RAUTIL,RA,RAD0)) Q:RAD0'>0!RAQUIT  D SHO
HLP     W ! S RAQUIT=0
        Q
SHO     W !?3,RA
        I $Y>(IOSL+RALINE-3) D PAUSE S RALINE=$Y
        Q
WRAP    ;
        W ! F  S Y=$L($E(RA,1,IOM-20)," ") W !?5,$P(RA," ",1,Y) S RA=$P(RA," ",Y+1,999) Q:RA=""
        Q
PAUSE   ;
        K DIR S DIR(0)="E" D ^DIR K DIR S RAQUIT=$S(Y:0,1:1)
        Q
        ; exclude SETDIC and SEL(Y) sections from routine RASELCT
        ;
EN5()   ;display identifier from file 71.9, field 5 radiopharm
        ; ^(0) is ^RAMIS(71.9,-,0)
        Q $$EN1(+$P(^(0),U,5),.01)