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

RAPSAPI.m

Go to the documentation of this file.
RAPSAPI ;HOIFO/SWM-calling Pharmacy APIs ; 20 Apr 2011  6:59 PM
 ;;5.0;Radiology/Nuclear Medicine;**65,1003**;Nov 01, 2010;Build 3
 ;
 ;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
 ;IHS/BJI/DAY - Patch 1003 - Temporary Change for patch 1003
 ;This can be removed when the full PSS patch is installed
 S X=$$GET1^DIQ(50,+RAX,RAN)
 Q X
 ;End Patch
 ; 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)