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

CIAOQN.m

Go to the documentation of this file. 
  1. CIAOQN ;MSC/IND/PLS - TIU QUICK NOTES ;04-May-2006 08:19;DKM
  1.  ;;1.1;VUECENTRIC COMPONENTS;**010002**;12-Aug-2004 22:06
  1.  ;;Copyright 2000-2006, Medsphere Systems Corporation
  1.  ;=================================================================
  1.  ; Quick Note management API
  1. MANAGE(DATA,ACTION,NAME,VAL,ENT) ;
  1.  N ENT1
  1.  S ENT1=$S(ENT="DIV":+DUZ(2)_";DIC(4,",1:+DUZ_";VA(200,")
  1.  S DATA=$$VALIDATE(.NAME,ACTION="C",.ENT)
  1.  Q:DATA
  1.  I ACTION="C" D SETLST(.DATA,NAME) Q
  1.  I ACTION="R" D RENLST(.DATA,NAME,.VAL) Q
  1.  I ACTION="S" D SETLST(.DATA,NAME,.VAL) Q
  1.  I ACTION="D" D DELLST(.DATA,NAME) Q
  1.  S DATA="-1^Unknown action"
  1.  Q
  1.  ; Validate Quick Note Name
  1. VALIDATE(NAME,DUP,ENT) ;
  1.  N L
  1.  S NAME=$$TRIM^CIAU(NAME),L=$L(NAME),DUP=+$G(DUP)
  1.  Q:L<3!(L>30) "-1^Quick Note name must be 3-30 characters in length."
  1.  Q:NAME'?.(1A,1N,1"_",1" ",1"-",1"(",1")") "-1^Quick Note name contains invalid characters."
  1.  I DUP,$$GETIEN(NAME) Q "-1^Quick Note name already exists."
  1.  I 'DUP,'$$GETIEN(NAME) Q "-1^Quick Note name not found."
  1.  Q ""
  1.  ; Rename existing Quick Note
  1.  ;  OLD  - Existing Instance name (aka Quick Note name)
  1.  ;  NEW  - New Quick Name name
  1. RENLST(DATA,OLD,NEW) ;
  1.  S DATA=$$VALIDATE(NEW,1)
  1.  D:'DATA REP^XPAR(ENT,$$PARAM,$$GETNAME(OLD),NEW,.DATA)
  1.  D:'DATA CHG^XPAR(ENT,$$PARAM,NEW,NEW,.DATA)
  1.  Q
  1.  ; Set Quick Note
  1. SETLST(DATA,NAME,VAL) ;
  1.  Q:'$L(NAME)
  1.  S:NAME=+NAME NAME=$$GETNAME(NAME)
  1.  S VAL=NAME
  1.  S:$D(VAL)'=11 VAL(1,0)=""
  1.  D EN^XPAR(ENT,$$PARAM,NAME,.VAL,.DATA)
  1.  Q
  1.  ; Delete Quick Note
  1.  ;   NAME - Quick Note Name
  1. DELLST(DATA,NAME) ;
  1.  D DEL^XPAR(ENT,$$PARAM,$$GETNAME(NAME),.DATA)
  1.  Q
  1.  ; Return parameter name/ien
  1. PARAM(X) Q $S($G(X):$$FIND1^DIC(8989.51,,"X",$$PARAM),1:"CIAOQN QNOTES")
  1.  ; Return IEN to file 8989.5
  1. GETIEN(NAME) ;
  1.  Q $S(NAME=+NAME:NAME,1:$O(^XTV(8989.5,"AC",$$PARAM(1),ENT1,NAME,0)))
  1.  ; Returns instance name for 8989.5 IEN
  1. GETNAME(IEN) ;
  1.  Q $S(IEN=+IEN:$$GET1^DIQ(8989.5,IEN_",",.03),1:IEN)
  1.  ;
  1.  ; Return TIU Template Node
  1.  ; Input: TIEN - IEN to ^TIU(8927
  1. GETTEMPL(DATA,TIEN) ;
  1.  S DATA=""
  1.  S:'TIEN TIEN=$O(^TIU(8927,"B",TIEN,0))
  1.  Q:'TIEN
  1.  S DATA=$$NODEDATA^TIUSRVT(TIEN)
  1.  Q
  1.  ; Returns 1 if template selection allowed
  1. TMPLSCRN(NODE) ;
  1.  I $P(NODE,U,3)="G"!($P(NODE,U,3)="T") Q 1
  1.  Q 0
  1.  ; Return Class for given Document Title
  1. GETDOCCL(DATA,DIEN) ;
  1.  S DATA=""
  1.  S:'DIEN DIEN=$O(^TIU(8925.1,"B",DIEN,0))
  1.  Q:'DIEN
  1.  S DATA=$$DOCCLASS^TIULC1(DIEN)
  1.  Q
  1.  ; Returns available New Person entries for CoSigner
  1. GCSIGLST(DATA,FROM,DIR,TITLE,AUTHOR,DATE) ;EP
  1.  N I,IEN,CNT
  1.  S I=0,CNT=44,DATE=$G(DATE)
  1.  F  Q:I'<CNT  S FROM=$O(^VA(200,"B",FROM),DIR) Q:FROM=""  D
  1.  .S IEN="" F  S IEN=$O(^VA(200,"B",FROM,IEN),DIR) Q:'IEN  D
  1.  ..I $$VCOSIG(IEN,TITLE,DATE) D
  1.  ...S I=I+1,DATA(I)=IEN_U_FROM
  1.  Q
  1.  ; Returns flag indicating the availability of the new person to cosign note
  1. VCOSIG(NPIEN,TITLEIEN,ACTDATE) ;EP
  1.  N VAL
  1.  S VAL=1
  1.  I ACTDATE>0,$$GET^XUA4A72(NPIEN,DATE)<1 D
  1.  .S VAL=0
  1.  E  D
  1.  .; A non-Provider may NOT be selected
  1.  .I +$$PROVIDER^TIUPXAP1(NPIEN,DT)'>0 S VAL=0
  1.  .; Others who require Cosignature may NOT be selected
  1.  .E  I +$$REQCOSIG^TIULP(TITLEIEN,0,NPIEN) S VAL=0
  1.  .; Author may NOT be selected
  1.  .E  I NPIEN=AUTHOR S VAL=0
  1.  Q VAL
  1.  ; Return need for cosignature
  1. REQCOS(DATA,TIUTYP,TIUSER) ; EP
  1.  S DATA=$$REQCOSIG^TIULP(TIUTYP,0,+$G(TIUSER))
  1.  Q