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

RAPSAPI3.m

Go to the documentation of this file. 
  1. RAPSAPI3 ;HOIFO/SG - INPUT TEMPLATE UTILS FOR PHARM. POINTERS ; 4/13/07 10:45am
  1.  ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ; 
  1.  ; #2056         GET1^DIQ
  1.  ; #2052         FIELD^DID
  1.  ; #2055         ROOT^DILFD
  1.  ; #10007        DO^DIC1
  1.  ; #4551         DIC^PSSDI  looks up & screens records from file #50
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** RETURNS IEN OF THE DEFAULT RECORD OF THE MULTIPLE
  1.  ;
  1.  ; Note: This is an internal function. Do not call it from outside
  1.  ;       of this routine.
  1.  ;
  1. DFLTREC() ;
  1.  Q $S($G(RADESCR("SELCNT"))'>1:+$O(@(RADESCR("ROOT"))@(" "),-1),1:0)
  1.  ;
  1.  ;***** EDITS RADIOLOGY SCREENED POINTER TO THE DRUG FILE (#50)
  1.  ;
  1.  ; RADESCR       Flags that control execution
  1.  ;                 "P"  Medications
  1.  ;                 "R"  Radiopharms
  1.  ;
  1.  ; RAIENS        IENS of the edited record (e.g. "1,")
  1.  ;
  1.  ; RAFILE        Radiology file number (e.g. 71.9)
  1.  ;
  1.  ; RAFIELD       Field number of the pointer to the file #50 (e.g. 5)
  1.  ;
  1.  ; [RADATE]      Date for screening medications
  1.  ;
  1.  ; Return values:
  1.  ;       ""  Field was empty and the value has not changed
  1.  ;      "@"  Clear the field
  1.  ;      "^"  Exit the record editing
  1.  ;   ^Field  "^"-jump to other field (e.g. "^KIT")
  1.  ;     `IEN  Pointer to the record of the file #50 (e.g. "`234")
  1.  ;
  1. RXEDIT(RADESCR,RAIENS,RAFILE,RAFIELD,RADATE) ;
  1.  N PSSDIY,RA50IEN,RABUF,RADIC,RAENTRY,RALABEL,RAMSG,RARC,RAVACL,TMP
  1.  ;=== Validate and parse parameters
  1.  S RADESCR=$G(RADESCR)
  1.  S:(RADESCR'["P")&(RADESCR'["R") RADESCR=RADESCR_"P"
  1.  S:$G(RADATE)'>0 RADATE=""
  1.  ;
  1.  ;=== Get field info from the data dictionary
  1.  D FIELD^DID(RAFILE,RAFIELD,,"LABEL;MULTIPLE-VALUED","RABUF","RAMSG")
  1.  I $G(RABUF("MULTIPLE-VALUED"))  S TMP=$T(+0)  D  Q "^"
  1.  . W !!,"$$RXEDIT^"_TMP_" cannot be used for multiples!"
  1.  . W !,"Use $$RXMEDIT^"_TMP_" instead.",!
  1.  S RALABEL=RABUF("LABEL")_": "
  1.  K RABUF
  1.  ;
  1.  ;===
  1.  F  D  Q:$D(RARC)
  1.  . ;--- Get the current internal value of the field
  1.  . S RA50IEN=+$$GET1^DIQ(RAFILE,RAIENS,RAFIELD,"I",,"RAMSG")
  1.  . ;--- Get the external value of the field
  1.  . I RA50IEN>0  D
  1.  . . S TMP=$$EN1^RAPSAPI(RA50IEN,.01)
  1.  . . S:TMP="" TMP=RA50IEN
  1.  . E  S TMP=""
  1.  . ;--- Display the prompt and get a user response
  1.  . W !,RALABEL_$S(TMP'="":TMP_"// ",1:"")
  1.  . R RAENTRY:DTIME  E  S RARC="^"  Q
  1.  . ;--- Keep the current value
  1.  . I RAENTRY=""  S RARC=$S(RA50IEN>0:"`"_RA50IEN,1:"")  Q
  1.  . ;--- Exit or "^"-jump
  1.  . I RAENTRY?1"^".E  S RARC=RAENTRY  Q
  1.  . ;--- @ entered
  1.  . I RAENTRY="@"  S:$$DELCONF^RAPSAPI2(+RAIENS,RA50IEN) RARC="@"  Q
  1.  . ;--- ? or ?? entered
  1.  . D:RAENTRY?1"?".1"?" HELP^RAPSAPI2(RAENTRY,RAFILE,RAFIELD)
  1.  . ;--- Something else entered
  1.  . S RADIC="^PSDRUG(",RADIC(0)="EQMZ",RADIC("A")=RALABEL
  1.  . D SETVACL^RAPSAPI2(RADESCR)
  1.  . D DIC^PSSDI(50,"RA",.RADIC,RAENTRY,,RADATE,,.RAVACL)
  1.  . S:Y>0 RARC="`"_(+Y)
  1.  ;
  1.  ;===
  1.  Q RARC
  1.  ;
  1.  ;***** EDITS .01 POINTER (MULTIPLE) TO THE DRUG FILE (#50)
  1.  ;
  1.  ; .RADESCR(     Flags that control execution
  1.  ;                 "P"  Medications
  1.  ;                 "R"  Radiopharms
  1.  ;
  1.  ;               When this function finishes editing the multiple,
  1.  ;               this parameter is KILL'ed automatically.
  1.  ;
  1.  ;               Subscripts of this parameter store the state between
  1.  ;               calls. Do not access them outside of this function!
  1.  ;               The only exception is the RADESCR("RESULT") that
  1.  ;               stores the latest value returned by the function.
  1.  ;
  1.  ;   "EDITONLY") The function is in "edit-only" mode of the .01 field 
  1.  ;               of the multiple.
  1.  ;
  1.  ;   "FLDNAME")  Name of the .01 field of the multiple
  1.  ;   "MLTNAME")  Name of the multiple
  1.  ;   "RESULT")   The latest result returned by this function
  1.  ;   "ROOT")     Closed root of the multiple's sub-file
  1.  ;   "SCRDATE")  Date for screening meds (value of the RADATE param.)
  1.  ;
  1.  ;   "SELCNT")   Number of times the function was called in selection 
  1.  ;               mode ($G("EDITONLY")=0) without resetting the state. 
  1.  ;
  1.  ;   "SUBFILE")  Number of the multiple's sub-file
  1.  ;
  1.  ; RAIENS        IENS of a multiple/subfile (e.g. ",1,") or IENS
  1.  ;               of a record of the multiple (e.g. "2,3,"). In the
  1.  ;               latter case, the function switches to "edit-only"
  1.  ;               mode.
  1.  ;
  1.  ; [RAFILE]      Radiology file number (e.g. 70.2)
  1.  ;
  1.  ; [RAMULT]      Field number of the multiple (e.g. 100)
  1.  ;
  1.  ; [RADATE]      Date for screening medications
  1.  ;
  1.  ; Return values:
  1.  ;       ""  Exit the multiple
  1.  ;      "@"  Delete the value of the .01 field
  1.  ;      "^"  Exit the record editing
  1.  ;   ^Field  "^"-jump to other field (e.g. "^KIT")
  1.  ;     `IEN  Pointer to the record of the file #50 or IEN of
  1.  ;           an existing record of the multiple (e.g. "`234")
  1.  ;
  1. RXMEDIT(RADESCR,RAIENS,RAFILE,RAMULT,RADATE) ;
  1.  N RASUBIEN      ; IEN of the record of the multiple
  1.  ;
  1.  N PSSDIY,RA50IEN,RADEFDIS,RADEFVAL,RADIC,RADUP,RAENTRY,RAMIEN,RAMSG,RARC,RAVACL,RAXNODE,TMP
  1.  ;=== Validate and parse parameters
  1.  S RADESCR=$G(RADESCR)
  1.  S:(RADESCR'["P")&(RADESCR'["R") RADESCR=RADESCR_"P"
  1.  S RASUBIEN=+$P(RAIENS,","),$P(RAIENS,",")=""
  1.  ;
  1.  ;=== Get file/field info from the data dictionary
  1.  I '$G(RADESCR("SELCNT"))  D  I $D(RARC)  K RADESCR  Q RARC
  1.  . N RABUF,SUBFILE
  1.  . S TMP="LABEL;MULTIPLE-VALUED;SPECIFIER"
  1.  . D FIELD^DID(RAFILE,RAMULT,,TMP,"RABUF","RAMSG")
  1.  . ;---
  1.  . I '$G(RABUF("MULTIPLE-VALUED"))  S TMP=$T(+0)  D  S RARC="^"  Q
  1.  . . W !!,"$$RXMEDIT^"_TMP_" cannot be used for single-value fields!"
  1.  . . W !,"Use $$RXEDIT^"_TMP_" instead.",!
  1.  . ;---
  1.  . S RADESCR("MLTNAME")=RABUF("LABEL")
  1.  . S (RADESCR("SUBFILE"),SUBFILE)=+RABUF("SPECIFIER")
  1.  . S RADESCR("FLDNAME")=$$GET1^DID(SUBFILE,.01,,"LABEL",,"RAMSG")
  1.  . S RADESCR("ROOT")=$$ROOT^DILFD(SUBFILE,RAIENS,1)
  1.  . S RADESCR("SCRDATE")=$S($G(RADATE)>0:+RADATE,1:"")
  1.  ;
  1.  ;=== Determine the execution mode
  1.  I RASUBIEN'>0  D  K RADESCR("EDITONLY")
  1.  . S RADESCR("SELCNT")=$G(RADESCR("SELCNT"))+1
  1.  . S RASUBIEN=$$DFLTREC()
  1.  E  S RADESCR("EDITONLY")=1
  1.  ;
  1.  ;===
  1.  F  D  Q:$D(RARC)
  1.  . ;--- Get the current internal value of the .01 field
  1.  . I RASUBIEN>0  D
  1.  . . S TMP=RASUBIEN_RAIENS
  1.  . . S RA50IEN=+$$GET1^DIQ(RADESCR("SUBFILE"),TMP,.01,"I",,"RAMSG")
  1.  . E  S RA50IEN=0
  1.  . ;--- Get the external value of the .01 field
  1.  . I RA50IEN>0  D
  1.  . . S RADEFVAL=$$EN1^RAPSAPI(RA50IEN,.01)
  1.  . . S:RADEFVAL="" RADEFVAL=RA50IEN
  1.  . E  S RADEFVAL=""
  1.  . S RADEFDIS=": "_$S(RADEFVAL'="":RADEFVAL_"// ",1:"")
  1.  . ;--- Display the prompt and get a user response
  1.  . W !  W:'$G(RADESCR("EDITONLY")) "Select "
  1.  . W RADESCR("FLDNAME")_RADEFDIS
  1.  . R RAENTRY:DTIME  E  S RARC="^"  Q
  1.  . ;--- Keep the current value or exit if there is no current record
  1.  . I RAENTRY=""  D   Q
  1.  . . I RASUBIEN'>0  S RARC=""  Q
  1.  . . ;--- If selecting a record, return IEN in the multiple
  1.  . . I '$G(RADESCR("EDITONLY"))  S RARC="`"_RASUBIEN  Q
  1.  . . ;--- If just editing the .01 field, return IEN in the DRUG file
  1.  . . S RARC=$S(RA50IEN>0:"`"_RA50IEN,1:"")
  1.  . ;--- Exit or "^"-jump
  1.  . I RAENTRY?1"^".E  S RARC=RAENTRY  Q
  1.  . ;--- @ entered
  1.  . I RAENTRY="@"  D:$$DELCONF^RAPSAPI2(RASUBIEN,RA50IEN)  Q
  1.  . . ;--- Let the FileMan delete the value of the .01 field
  1.  . . I $G(RADESCR("EDITONLY"))  S RARC="@"  Q
  1.  . . ;--- Delete the record at "Select ..." prompt
  1.  . . D DELETE^RAPSAPI2(RADESCR("SUBFILE"),RASUBIEN_RAIENS)
  1.  . . S RASUBIEN=$$DFLTREC()
  1.  . ;--- Record IEN entered
  1.  . I RAENTRY?1"`"1.N  S:$$IEN^RAPSAPI2(.RAENTRY) RARC=RAENTRY  Q
  1.  . ;--- Add duplicate entry (value in double quotes)
  1.  . I RAENTRY?1""""1.E1""""  D  S RADUP=1
  1.  . . S RAENTRY=$E(RAENTRY,2,$L(RAENTRY)-1)  ; Remove quotes
  1.  . E  S RADUP=0
  1.  . ;--- ? or ?? entered
  1.  . I RAENTRY?1"?".1"?"  D  S RADUP=0
  1.  . . I $G(RADESCR("EDITONLY"))  D  Q
  1.  . . . D HELP^RAPSAPI2(RAENTRY,RADESCR("SUBFILE"),.01)
  1.  . . D HELP^RAPSAPI2(RAENTRY,RAFILE,RAMULT,RAIENS)
  1.  . ;--- Everything else
  1.  . S RADIC="^PSDRUG(",RADIC(0)="EQMZ"
  1.  . S RADIC("A")=RADESCR("FLDNAME")_": "
  1.  . D SETVACL^RAPSAPI2(RADESCR)
  1.  . D DIC^PSSDI(50,"RA",.RADIC,RAENTRY,,RADESCR("SCRDATE"),,.RAVACL)
  1.  . Q:Y'>0
  1.  . ;--- If just editing the .01 field, return IEN in the DRUG file
  1.  . I $G(RADESCR("EDITONLY"))  S RARC="`"_(+Y)  Q
  1.  . ;--- Try to find the drug in the multiple.
  1.  . ;--- If not found or duplication is forced, add the drug.
  1.  . S RAXNODE=$NA(@(RADESCR("ROOT"))@("B",+Y))
  1.  . S RAMIEN=+$O(@RAXNODE@(0))
  1.  . I (RAMIEN'>0)!RADUP  S RARC="""`"_(+Y)_""""  Q
  1.  . ;--- Otherwise, select a record from the multiple.
  1.  . I $O(@RAXNODE@(RAMIEN))>0  D  Q:RAMIEN'>0
  1.  . . S RAMIEN=$$MULTSEL^RAPSAPI2(RAXNODE,RADESCR("MLTNAME"),$P(Y,U,2))
  1.  . S RARC="`"_RAMIEN
  1.  ;
  1.  ;=== Cleanup
  1.  S RADESCR("RESULT")=RARC
  1.  D:'$G(RADESCR("EDITONLY"))
  1.  . K:(RARC="^")!((RARC="")&(RA50IEN'>0)) RADESCR
  1.  Q RARC