- AMQQ2 ; IHS/CMI/THL - QUERY NAME LOOKUP ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;-----
- START S AMQQTXT=X
- I AMQQTXT["," S AMQQNAME=AMQQTXT G RUN
- I X?1N.N D HRN Q
- I AMQQTXT'[" " S AMQQNAME=AMQQTXT G RUN
- S (AMQQNAME,AMQQTXT)=$P(X," ",$L(X," "))_","_$P(X," ",1,$L(X," ")-1)
- RUN S AMQQDIC="^DPT("
- D LOOKUP
- S AMQQPTL=Z
- S AMQQPRL=0
- I '(AMQQPRL+AMQQPTL) G UNK
- I '(AMQQPRL*AMQQPTL) S AMQQPTYP=$S(AMQQPRL:"PRO",1:"PT") D ONE G EXIT
- W !,"Is ",AMQQNAME," a patient"
- S %=1
- D YN^DICN
- I $D(DTOUT) K DTOUT S %Y=U
- I $E(%Y)=U S AMQQQUIT="" G EXIT
- I %Y="" S %Y="Y"
- I "Yy"[$E(%Y) S AMQQPTYP="PT" D ONE G EXIT
- W !,"Well then, is ",AMQQNAME," a provider"
- S %=1
- D YN^DICN
- I $D(DTOUT) S %Y=U
- I $E(%Y)=U S AMQQQUIT="" Q
- I %Y="" S %Y="Y"
- I "Yy"[$E(X) S AMQQPTYP="PRO" D ONE G EXIT
- UNK I '$D(AMQQXX) W !!,*7,"I have NO idea who or what "_AMQQNAME_" is." S AMQQFAIL=""
- EXIT ;
- K AMQQDIC,AMQQNAME,AMQQPRL,AMQQPTL,AMQQPTYP,AMQQTXT,%,X1,X2,A,B,N,Z
- Q
- ;
- ONE S (AMQQDIC,DIC)=$S(AMQQPTYP="PRO":($E(AMQQ200(16),1,$L(AMQQ200)-1)_","),1:"^DPT(")
- S DIC(0)="I"
- S X=AMQQTXT
- I @$S(AMQQPTYP="PRO":"AMQQPRL",1:"AMQQPTL")=2 W !!,"Select one of the following "_$S(AMQQPTYP="PRO":"providers",1:"patients")_":",! S DIC(0)="IEQ"
- D ^DIC
- I Y=-1,Z'=1 S DIC(0)="E" D ^DIC K DIC G GO
- S X="`"_+Y
- S DIC(0)="E"
- W !
- D ^DIC
- K DIC
- GO I Y=-1 S AMQQFAIL="" Q
- S Y=AMQQDIC_U_Y
- Q
- ;
- LOOKUP S AMQQ=AMQQDIC_"""B"")"
- S Z=0
- S Y=AMQQNAME
- S A=$E(Y,1,$L(Y)-1)
- S B=$E(Y,$L(Y))
- S B=$A(B)
- S B=B-1
- S B=$C(B)
- S B=B_"|||"
- S Y=A_B
- 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
- QL K N,Y,AMQQ
- Q
- ;
- HRN ;EP;TO EVALUATE HEALTH RECORD NUMBER
- S DIC="^DPT("
- S DIC(0)="EMQZ"
- D ^DIC
- S AMQQDIC="^DPT("
- D GO
- Q
- AMQQ2 ; IHS/CMI/THL - QUERY NAME LOOKUP ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;-----
- START SET AMQQTXT=X
- +1 IF AMQQTXT[","
- SET AMQQNAME=AMQQTXT
- GOTO RUN
- +2 IF X?1N.N
- DO HRN
- QUIT
- +3 IF AMQQTXT'[" "
- SET AMQQNAME=AMQQTXT
- GOTO RUN
- +4 SET (AMQQNAME,AMQQTXT)=$PIECE(X," ",$LENGTH(X," "))_","_$PIECE(X," ",1,$LENGTH(X," ")-1)
- RUN SET AMQQDIC="^DPT("
- +1 DO LOOKUP
- +2 SET AMQQPTL=Z
- +3 SET AMQQPRL=0
- +4 IF '(AMQQPRL+AMQQPTL)
- GOTO UNK
- +5 IF '(AMQQPRL*AMQQPTL)
- SET AMQQPTYP=$SELECT(AMQQPRL:"PRO",1:"PT")
- DO ONE
- GOTO EXIT
- +6 WRITE !,"Is ",AMQQNAME," a patient"
- +7 SET %=1
- +8 DO YN^DICN
- +9 IF $DATA(DTOUT)
- KILL DTOUT
- SET %Y=U
- +10 IF $EXTRACT(%Y)=U
- SET AMQQQUIT=""
- GOTO EXIT
- +11 IF %Y=""
- SET %Y="Y"
- +12 IF "Yy"[$EXTRACT(%Y)
- SET AMQQPTYP="PT"
- DO ONE
- GOTO EXIT
- +13 WRITE !,"Well then, is ",AMQQNAME," a provider"
- +14 SET %=1
- +15 DO YN^DICN
- +16 IF $DATA(DTOUT)
- SET %Y=U
- +17 IF $EXTRACT(%Y)=U
- SET AMQQQUIT=""
- QUIT
- +18 IF %Y=""
- SET %Y="Y"
- +19 IF "Yy"[$EXTRACT(X)
- SET AMQQPTYP="PRO"
- DO ONE
- GOTO EXIT
- UNK IF '$DATA(AMQQXX)
- WRITE !!,*7,"I have NO idea who or what "_AMQQNAME_" is."
- SET AMQQFAIL=""
- EXIT ;
- +1 KILL AMQQDIC,AMQQNAME,AMQQPRL,AMQQPTL,AMQQPTYP,AMQQTXT,%,X1,X2,A,B,N,Z
- +2 QUIT
- +3 ;
- ONE SET (AMQQDIC,DIC)=$SELECT(AMQQPTYP="PRO":($EXTRACT(AMQQ200(16),1,$LENGTH(AMQQ200)-1)_","),1:"^DPT(")
- +1 SET DIC(0)="I"
- +2 SET X=AMQQTXT
- +3 IF @$SELECT(AMQQPTYP="PRO":"AMQQPRL",1:"AMQQPTL")=2
- WRITE !!,"Select one of the following "_$SELECT(AMQQPTYP="PRO":"providers",1:"patients")_":",!
- SET DIC(0)="IEQ"
- +4 DO ^DIC
- +5 IF Y=-1
- IF Z'=1
- SET DIC(0)="E"
- DO ^DIC
- KILL DIC
- GOTO GO
- +6 SET X="`"_+Y
- +7 SET DIC(0)="E"
- +8 WRITE !
- +9 DO ^DIC
- +10 KILL DIC
- GO IF Y=-1
- SET AMQQFAIL=""
- QUIT
- +1 SET Y=AMQQDIC_U_Y
- +2 QUIT
- +3 ;
- LOOKUP SET AMQQ=AMQQDIC_"""B"")"
- +1 SET Z=0
- +2 SET Y=AMQQNAME
- +3 SET A=$EXTRACT(Y,1,$LENGTH(Y)-1)
- +4 SET B=$EXTRACT(Y,$LENGTH(Y))
- +5 SET B=$ASCII(B)
- +6 SET B=B-1
- +7 SET B=$CHAR(B)
- +8 SET B=B_"|||"
- +9 SET Y=A_B
- +10 FOR
- SET Y=$ORDER(@AMQQ@(Y))
- IF $EXTRACT(Y,1,$LENGTH(AMQQNAME))'=AMQQNAME
- QUIT
- FOR N=0:0
- SET N=$ORDER(@AMQQ@(Y,N))
- IF N=""
- QUIT
- SET Z=Z+1
- IF Z=2
- GOTO QL
- QL KILL N,Y,AMQQ
- +1 QUIT
- +2 ;
- HRN ;EP;TO EVALUATE HEALTH RECORD NUMBER
- +1 SET DIC="^DPT("
- +2 SET DIC(0)="EMQZ"
- +3 DO ^DIC
- +4 SET AMQQDIC="^DPT("
- +5 DO GO
- +6 QUIT