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

AMQQ2.m

Go to the documentation of this file.
  1. AMQQ2 ; IHS/CMI/THL - QUERY NAME LOOKUP ;
  1. ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1. ;-----
  1. START S AMQQTXT=X
  1. I AMQQTXT["," S AMQQNAME=AMQQTXT G RUN
  1. I X?1N.N D HRN Q
  1. I AMQQTXT'[" " S AMQQNAME=AMQQTXT G RUN
  1. S (AMQQNAME,AMQQTXT)=$P(X," ",$L(X," "))_","_$P(X," ",1,$L(X," ")-1)
  1. RUN S AMQQDIC="^DPT("
  1. D LOOKUP
  1. S AMQQPTL=Z
  1. S AMQQPRL=0
  1. I '(AMQQPRL+AMQQPTL) G UNK
  1. I '(AMQQPRL*AMQQPTL) S AMQQPTYP=$S(AMQQPRL:"PRO",1:"PT") D ONE G EXIT
  1. W !,"Is ",AMQQNAME," a patient"
  1. S %=1
  1. D YN^DICN
  1. I $D(DTOUT) K DTOUT S %Y=U
  1. I $E(%Y)=U S AMQQQUIT="" G EXIT
  1. I %Y="" S %Y="Y"
  1. I "Yy"[$E(%Y) S AMQQPTYP="PT" D ONE G EXIT
  1. W !,"Well then, is ",AMQQNAME," a provider"
  1. S %=1
  1. D YN^DICN
  1. I $D(DTOUT) S %Y=U
  1. I $E(%Y)=U S AMQQQUIT="" Q
  1. I %Y="" S %Y="Y"
  1. I "Yy"[$E(X) S AMQQPTYP="PRO" D ONE G EXIT
  1. UNK I '$D(AMQQXX) W !!,*7,"I have NO idea who or what "_AMQQNAME_" is." S AMQQFAIL=""
  1. EXIT ;
  1. K AMQQDIC,AMQQNAME,AMQQPRL,AMQQPTL,AMQQPTYP,AMQQTXT,%,X1,X2,A,B,N,Z
  1. Q
  1. ;
  1. ONE S (AMQQDIC,DIC)=$S(AMQQPTYP="PRO":($E(AMQQ200(16),1,$L(AMQQ200)-1)_","),1:"^DPT(")
  1. S DIC(0)="I"
  1. S X=AMQQTXT
  1. I @$S(AMQQPTYP="PRO":"AMQQPRL",1:"AMQQPTL")=2 W !!,"Select one of the following "_$S(AMQQPTYP="PRO":"providers",1:"patients")_":",! S DIC(0)="IEQ"
  1. D ^DIC
  1. I Y=-1,Z'=1 S DIC(0)="E" D ^DIC K DIC G GO
  1. S X="`"_+Y
  1. S DIC(0)="E"
  1. W !
  1. D ^DIC
  1. K DIC
  1. GO I Y=-1 S AMQQFAIL="" Q
  1. S Y=AMQQDIC_U_Y
  1. Q
  1. ;
  1. LOOKUP S AMQQ=AMQQDIC_"""B"")"
  1. S Z=0
  1. S Y=AMQQNAME
  1. S A=$E(Y,1,$L(Y)-1)
  1. S B=$E(Y,$L(Y))
  1. S B=$A(B)
  1. S B=B-1
  1. S B=$C(B)
  1. S B=B_"|||"
  1. S Y=A_B
  1. F S Y=$O(@AMQQ@(Y)) Q:$E(Y,1,$L(AMQQNAME))'=AMQQNAME F N=0:0 S N=$O(@AMQQ@(Y,N)) Q:N="" S Z=Z+1 I Z=2 G QL
  1. QL K N,Y,AMQQ
  1. Q
  1. ;
  1. HRN ;EP;TO EVALUATE HEALTH RECORD NUMBER
  1. S DIC="^DPT("
  1. S DIC(0)="EMQZ"
  1. D ^DIC
  1. S AMQQDIC="^DPT("
  1. D GO
  1. Q