RMPFDT8 ;DDC/KAW-DISPLAY AUTHORIZED AIDS [ 03/12/98 7:46 AM ]
;;2.0;REMOTE ORDER/ENTRY SYSTEM;**10**;;JUN 16, 1995
;; input: RMPFX,DFN
;;output: None
Q:'$D(^RMPF(791810,RMPFX,301,1,0)) S Y=$P(^(0),U,8) D DD^%DT S DV=Y
D PAT^RMPFUTL,HEAD S (RX,CT)=0
A1 S RX=$O(^RMPF(791810,RMPFX,301,RX)) G TOT:'RX
G A1:'$D(^RMPF(791810,RMPFX,301,RX,0)) S S0=^(0),CT=CT+1
S ID=$P(S0,U,3) S:ID?7N ID=$E(ID,4,5)_"-"_$E(ID,6,7)_"-"_($E(ID,1,3)+1700)
S MK=$E($P(S0,U,2),1,12),MD=$E($P(S0,U,1),1,12),SN=$E($P(S0,U,4),1,10)
S ST=$E($P(S0,U,5),1,4),BT=$E($P(S0,U,6),1,7),ER=$P(S0,U,7)
W !,$J(CT,2),?5,ID,?17,MK,?32,MD,?49,SN,?61,ST,?67,BT,?77,ER
G A1
TOT W !!,"Total Number of Authorized Hearing Aids: ",CT
I IOST?1"P-".E W @IOF
D:$D(IO("S")) ^%ZISC
I IOST?1"C-".E D CONT,QUE:"Pp"[Y&(Y'="") I $D(RMION) K RMION G RMPFDT8
END K Y,DV,RX,CT,S0,ID,MK,MD,SN,ST,BT,ER,ZTSK,RMPFOUT,RMPFQUT,I,POP
K RMPFDOB,RMPFDOD,RMPFNAM,RMPFSSN,%XX,%YY,X Q
HEAD I IOST'?1"P-".E W @IOF
W !?28,"AUTHORIZED HEARING AIDS",!
W !?2,"Patient Name: ",RMPFNAM,?63,"SSN: ",RMPFSSN
W !,"Aids Validated: ",DV
W !?51,"Serial"
W !," #",?5,"Issue Date",?21,"Make",?37,"Model",?51,"Number",?61,"Sta.",?67,"Battery",?76,"Ear"
W !,"---",?5,"----------",?17,"-------------",?32,"---------------",?49,"----------",?61,"----",?67,"-------",?76,"---"
Q
CONT F I=1:1 Q:$Y>21 W !
W !,"Enter <RETURN> to continue or <P>rint: " D READ
I $D(RMPFQUT) D MSG^RMPFDD G CONT
Q:Y="" S Y=$E(Y,1) I "Pp"'[Y G CONT
Q
QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP K RMION
I IO=IO(0),'$D(IO("S")) K ZTSK S RMION=IO Q
I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G ^RMPFDT8
S ZTRTN="^RMPFDT8",ZTDESC="AUTH AIDS",ZTIO=ION
S ZTSAVE("RMPFX")="",ZTSAVE("DFN")="" D ^%ZTLOAD
D HOME^%ZIS W:$D(ZTSK) !!,"*** Request Queued ***" H 2
K %T,POP Q
READ K RMPFOUT,RMPFQUT
R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
I Y?1"^".E S (RMPFOUT,Y)="" Q
S:Y?1"?".E (RMPFQUT,Y)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFDT8 1957 printed Sep 23, 2025@20:12:19 Page 2
RMPFDT8 ;DDC/KAW-DISPLAY AUTHORIZED AIDS [ 03/12/98 7:46 AM ]
+1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**10**;;JUN 16, 1995
+2 ;; input: RMPFX,DFN
+3 ;;output: None
+4 if '$DATA(^RMPF(791810,RMPFX,301,1,0))
QUIT
SET Y=$PIECE(^(0),U,8)
DO DD^%DT
SET DV=Y
+5 DO PAT^RMPFUTL
DO HEAD
SET (RX,CT)=0
A1 SET RX=$ORDER(^RMPF(791810,RMPFX,301,RX))
if 'RX
GOTO TOT
+1 if '$DATA(^RMPF(791810,RMPFX,301,RX,0))
GOTO A1
SET S0=^(0)
SET CT=CT+1
+2 SET ID=$PIECE(S0,U,3)
if ID?7N
SET ID=$EXTRACT(ID,4,5)_"-"_$EXTRACT(ID,6,7)_"-"_($EXTRACT(ID,1,3)+1700)
+3 SET MK=$EXTRACT($PIECE(S0,U,2),1,12)
SET MD=$EXTRACT($PIECE(S0,U,1),1,12)
SET SN=$EXTRACT($PIECE(S0,U,4),1,10)
+4 SET ST=$EXTRACT($PIECE(S0,U,5),1,4)
SET BT=$EXTRACT($PIECE(S0,U,6),1,7)
SET ER=$PIECE(S0,U,7)
+5 WRITE !,$JUSTIFY(CT,2),?5,ID,?17,MK,?32,MD,?49,SN,?61,ST,?67,BT,?77,ER
+6 GOTO A1
TOT WRITE !!,"Total Number of Authorized Hearing Aids: ",CT
+1 IF IOST?1"P-".E
WRITE @IOF
+2 if $DATA(IO("S"))
DO ^%ZISC
+3 IF IOST?1"C-".E
DO CONT
if "Pp"[Y&(Y'="")
DO QUE
IF $DATA(RMION)
KILL RMION
GOTO RMPFDT8
END KILL Y,DV,RX,CT,S0,ID,MK,MD,SN,ST,BT,ER,ZTSK,RMPFOUT,RMPFQUT,I,POP
+1 KILL RMPFDOB,RMPFDOD,RMPFNAM,RMPFSSN,%XX,%YY,X
QUIT
HEAD IF IOST'?1"P-".E
WRITE @IOF
+1 WRITE !?28,"AUTHORIZED HEARING AIDS",!
+2 WRITE !?2,"Patient Name: ",RMPFNAM,?63,"SSN: ",RMPFSSN
+3 WRITE !,"Aids Validated: ",DV
+4 WRITE !?51,"Serial"
+5 WRITE !," #",?5,"Issue Date",?21,"Make",?37,"Model",?51,"Number",?61,"Sta.",?67,"Battery",?76,"Ear"
+6 WRITE !,"---",?5,"----------",?17,"-------------",?32,"---------------",?49,"----------",?61,"----",?67,"-------",?76,"---"
+7 QUIT
CONT FOR I=1:1
if $Y>21
QUIT
WRITE !
+1 WRITE !,"Enter <RETURN> to continue or <P>rint: "
DO READ
+2 IF $DATA(RMPFQUT)
DO MSG^RMPFDD
GOTO CONT
+3 if Y=""
QUIT
SET Y=$EXTRACT(Y,1)
IF "Pp"'[Y
GOTO CONT
+4 QUIT
QUE WRITE !
SET %ZIS="NPQ"
DO ^%ZIS
if POP
GOTO END
KILL RMION
+1 IF IO=IO(0)
IF '$DATA(IO("S"))
KILL ZTSK
SET RMION=IO
QUIT
+2 IF $DATA(IO("S"))
SET %ZIS=""
SET IOP=ION
DO ^%ZIS
GOTO ^RMPFDT8
+3 SET ZTRTN="^RMPFDT8"
SET ZTDESC="AUTH AIDS"
SET ZTIO=ION
+4 SET ZTSAVE("RMPFX")=""
SET ZTSAVE("DFN")=""
DO ^%ZTLOAD
+5 DO HOME^%ZIS
if $DATA(ZTSK)
WRITE !!,"*** Request Queued ***"
HANG 2
+6 KILL %T,POP
QUIT
READ KILL RMPFOUT,RMPFQUT
+1 READ Y:DTIME
IF '$TEST
WRITE $CHAR(7)
READ Y:5
if Y="."
GOTO READ
if '$TEST
SET Y=U
+2 IF Y?1"^".E
SET (RMPFOUT,Y)=""
QUIT
+3 if Y?1"?".E
SET (RMPFQUT,Y)=""
+4 QUIT
