RMPFDT6.m

RMPFDT6 ;DDC/KAW-PATIENT DISPLAY TYPE SPECIFIC MODEL SCREEN [ 03/10/98  1:46 PM ]

 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**Y2K**;JUN 16, 1995

PRTB I CX=1 D

 .W ! W:$D(RMPFEDIT)&$D(CN) "[",CN,"]" W ?42,"Product Group of",!,?4,"Battery Type",?20,"Quantity",?38,"Item Requiring Batteries",?73,"Status"

 .W !,?4,"-------------",?20,"--------",?31,"--------------------------------------",?72,"--------"

 W !,$J(CX,2),". ",$E(RMPFITP,1,16),?20,$J(RMPFQTY,5),?31,RMPFPG,?72,$E(RMPFLIS,1,8)

 Q

PRTD I CX<2 W ! W:$D(RMPFEDIT)&$D(CN) "[",CN,"]" W ?4,"Battery Type",?20,"Quantity",?31,"Status",!,?4,"-------------",?20,"--------",?31,"------"

 W !,$J(CX,2)," ",?4,$E(RMPFITP,1,16),?20,$J(RMPFQTY,8),?31,$E(RMPFLIS,1,6)

 Q

PRTG I CX<2 D HEAD W ?4,"Make",?16,"Model",?27,"Pur By",?35,"Serial #",?45,"Battery",?54,"Acq. Dt.",?64,"Replace SN",?75,"Stat." D LINE1

 W !,$J(CX,2)," ",$E(RMPFMAK,1,7),?11,$E(RMPFITP,1,15),?27,RMPFOB

 W ?34,$E(RMPFSN,1,9),?45,$E(RMPFBAT,1,7)

 W ?53,RMPFACQD

 I $D(RMPFN) S X=0 F K=1:1 S X=$O(RMPFN(X)) Q:'X  D

 .W:CT>0 ! W ?64,$E(RMPFN(X),1,13) S CT=CT+1

 .I CT=0 W ?75,$E(RMPFLIS,1,5) K RMPFLIS

 I $D(RMPFLIS) W ?75,$E(RMPFLIS,1,5)

 Q

PRTW D PRTQ Q

PRTM I CX=1 D

 .W ! W:$D(RMPFEDIT)&$D(CN) "[",CN,"]" W ?9,"Make",?27,"Model",?42,"Quantity",?56,"Components",?72,"Status"

 .W !,?4,"--------------",?20,"--------------------",?42,"--------",?52,"------------------",?72,"-------"

 W !,$J(CX,2),". ",$E(RMPFMAK,1,16),?20,$E(RMPFITP,1,20),?42,$J(RMPFQTY,5)

 S CM="" D COMP^RMPFDT3 W ?52,CM W:$L(CM)>18 !

 W ?72,$E(RMPFLIS,1,8)

 Q

PRTQ I CX<2 W ! W:$D(RMPFEDIT)&($D(CN)) "[",CN,"]" W ?8,"Hearing Aid Accessory",?36,"Quantity",?46,"Status",!,?4,"------------------------------",?36,"--------",?46,"------"

 W !,$J(CX,2)," ",?4,$E(RMPFITP,1,30),?35,$J(RMPFQTY,9),?46,$E(RMPFLIS,1,6)

 Q

PRTX I CX<2 D HEAD W ?6,"Make",?21,"Model",?35,"Component",?47,"Comp Price",?59,"Ear",?64,"Status" S RMPFTOT=0 W !?4,"--------",?14,"-------------------",?35,"----------",?47,"----------",?59,"---",?64,"------"

 W !,$J(CX,2)," ",?4,$E(RMPFMAK,1,8),?14,$E(RMPFITP,1,19)

 S X=0 F K=1:1 S X=$O(RMPFC(X)) Q:'X  S Y=$P(RMPFC(X),U,1) I Y D

 .Q:'$D(^RMPF(791811.2,Y,0))  S S3=^(0)

 .S RMPFCOM=$P(S3,U,3),RMPFCOMC=$J($P(RMPFC(X),U,2),0,2)

 .S RMPFTOT=RMPFTOT+RMPFCOMC

 .W:$X'>0 "(cont.)",!,$J(CX,2),". ",$E(RMPFMAK,1,8),?18,$E(RMPFITP,1,11),?27,$J(RMPFCOST,6)

 .W:CT ! W ?35,$E(RMPFCOM,1,9),?47,$J(RMPFCOMC,10)

 .W:CT=0 ?56,RMPFISDP,?60,$E(RMPFLR,1),?64,$E(RMPFLIS,1,6)

 .S CT=CT+1

 I RMPFSN'="" W !?4,"Serial Number: ",RMPFSN

 I RMPFCERU'="" W:RMPFSN="" ! W:$P(^RMPF(791810,RMPFX,101,RMPFY,90),U,10) ?32,"Re-" W ?33,"Certified: ",RMPFCERD,?57,"By: ",$E(RMPFCERU,1,19)

 Q

PRTN I CX<2 D

 .W !,?5,"Make",?14,"Model",?24,"Serial #",?35,"Iss Date",?45,"Battery",?53,"Type",?58,"Ear",?63,"Replace",?73,"Status"

 .W !?3,"-------",?11,"-----------",?23,"----------",?34,"----------",?45,"-------",?53,"----",?58,"---",?62,"----------",?73,"------"

 W !,$J(CX,2)," ",$E(RMPFMAK,1,7),?11,$E(RMPFITP,1,11),?23,RMPFSN,?34,RMPFISDP,?45,$E(RMPFBAT,1,7),?53,$E(RMPFISRE,1,4),?59,RMPFLR

 I $D(RMPFN) S X=0 F K=1:1 S X=$O(RMPFN(X)) Q:'X  W:CT>0 ! W ?62,$E(RMPFN(X),1,10) W:CT=0 ?73,$E(RMPFLIS,1,6) K RMPFLIS S CT=CT+1

 I $D(RMPFLIS) W ?73,$E(RMPFLIS,1,6)

 Q

PRTT I CX<2 D HEAD W !?5,"Make",?17,"Model",?28,"Serial #",?48,"Type of Loss",?72,"Status",!?3,"---------",?14,"-----------",?27,"----------",?39,"-------------------------------",?72,"------"

 W !,$J(CX,2)," ",$E(RMPFMAK,1,9),?14,$E(RMPFITP,1,11),?27,RMPFSN,?39,RMPFTOL,?72,$E(RMPFLIS,1,6)

 Q

PRTV I CX<2 W !?5,"Make",?19,"Model",?32,"Serial #",?43,"Recover Date",?57,"Ear",?62,"Status",!?3,"---------",?14,"---------------",?31,"----------",?43,"------------",?57,"---",?62,"------"

 W !,$J(CX,2)," ",$E(RMPFMAK,1,9),?14,$E(RMPFITP,1,15),?31,$E(RMPFSN,1,10),?43,RMPFRED,?58,RMPFLR,?62,$E(RMPFLIS,1,6)

 Q

PRTZ I CX<2 W:$D(RMPFEDIT)&$D(CN) "[",CN,"]" D

 .W ?59,"SC/",?70,"Spec"

 .W !?10,"Prosthetic Item",?34,"Qty",?39,"Price",?46,"Typ",?50,"Disabil.",?59,"NSC",?63,"Categ.",?70,"Cat.",?75,"Stat."

 .W !?3,"------------------------------",?34,"---",?38,"-------",?46,"---",?50,"--------",?59,"---",?63,"------",?70,"----",?75,"-----"

 Q:CX=0

 W !,$J(CX,2)," ",$E(RMPFITP,1,30),?34,$J(RMPFQTY,3),?38,$J((RMPFCOST*QT),7,2),?47,RMPFTT,?50,RMPFDIS,?60,RMPFDSN,?63,RMPFPCT,?70,RMPFPSC,?75,$E(RMPFLIS,1,5)

 Q

PRTJ I CX<2 W:$D(RMPFEDIT)&($D(CN)) "[",CN,"]" W !?11,"Prosthetic Item",?37,"Qty",?43,"Price",?51,"Status",!?3,"--------------------------------",?37,"---",?42,"-------",?51,"------"

 Q:CX=0

 W !,$J(CX,2)," ",$E(RMPFITP,1,32),?37,$J(RMPFQTY,3),?42,$J((RMPFCOST*QT),7,2),?51,$E(RMPFLIS,1,6)

 Q

HEAD W ! W:$D(RMPFEDIT)&$D(CN) "[",CN,"]"

 Q

LINE W !?4,"--------",?14,"-----------",?27,"------",?35,"----------",?47,"-------",?56,"--------",?66,"-" W:RMPFHAT'="H" ?69,"-----------"

 Q

LINE1 W !?3,"-------",?11,"---------------",?27,"------",?34,"----------",?45,"-------",?53,"----------",?64,"----------",?75,"-----"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RMPFDT6   5013     printed  Mar 13, 2025@21:41:02                                                                                                                                                                                                     Page 2

RMPFDT6   ;DDC/KAW-PATIENT DISPLAY TYPE SPECIFIC MODEL SCREEN [ 03/10/98  1:46 PM ]

 +1       ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**Y2K**;JUN 16, 1995

PRTB       IF CX=1

               Begin DoDot:1

 +1                WRITE !

                   if $DATA(RMPFEDIT)&$DATA(CN)

                       WRITE "[",CN,"]"

                   WRITE ?42,"Product Group of",!,?4,"Battery Type",?20,"Quantity",?38,"Item Requiring Batteries",?73,"Status"

 +2                WRITE !,?4,"-------------",?20,"--------",?31,"--------------------------------------",?72,"--------"

               End DoDot:1

 +3        WRITE !,$JUSTIFY(CX,2),". ",$EXTRACT(RMPFITP,1,16),?20,$JUSTIFY(RMPFQTY,5),?31,RMPFPG,?72,$EXTRACT(RMPFLIS,1,8)

 +4        QUIT 

PRTD       IF CX<2

               WRITE !

               if $DATA(RMPFEDIT)&$DATA(CN)

                   WRITE "[",CN,"]"

               WRITE ?4,"Battery Type",?20,"Quantity",?31,"Status",!,?4,"-------------",?20,"--------",?31,"------"

 +1        WRITE !,$JUSTIFY(CX,2)," ",?4,$EXTRACT(RMPFITP,1,16),?20,$JUSTIFY(RMPFQTY,8),?31,$EXTRACT(RMPFLIS,1,6)

 +2        QUIT 

PRTG       IF CX<2

               DO HEAD

               WRITE ?4,"Make",?16,"Model",?27,"Pur By",?35,"Serial #",?45,"Battery",?54,"Acq. Dt.",?64,"Replace SN",?75,"Stat."

               DO LINE1

 +1        WRITE !,$JUSTIFY(CX,2)," ",$EXTRACT(RMPFMAK,1,7),?11,$EXTRACT(RMPFITP,1,15),?27,RMPFOB

 +2        WRITE ?34,$EXTRACT(RMPFSN,1,9),?45,$EXTRACT(RMPFBAT,1,7)

 +3        WRITE ?53,RMPFACQD

 +4        IF $DATA(RMPFN)

               SET X=0

               FOR K=1:1

                   SET X=$ORDER(RMPFN(X))

                   if 'X

                       QUIT 

                   Begin DoDot:1

 +5                    if CT>0

                           WRITE !

                       WRITE ?64,$EXTRACT(RMPFN(X),1,13)

                       SET CT=CT+1

 +6                    IF CT=0

                           WRITE ?75,$EXTRACT(RMPFLIS,1,5)

                           KILL RMPFLIS

                   End DoDot:1

 +7        IF $DATA(RMPFLIS)

               WRITE ?75,$EXTRACT(RMPFLIS,1,5)

 +8        QUIT 

PRTW       DO PRTQ

           QUIT 

PRTM       IF CX=1

               Begin DoDot:1

 +1                WRITE !

                   if $DATA(RMPFEDIT)&$DATA(CN)

                       WRITE "[",CN,"]"

                   WRITE ?9,"Make",?27,"Model",?42,"Quantity",?56,"Components",?72,"Status"

 +2                WRITE !,?4,"--------------",?20,"--------------------",?42,"--------",?52,"------------------",?72,"-------"

               End DoDot:1

 +3        WRITE !,$JUSTIFY(CX,2),". ",$EXTRACT(RMPFMAK,1,16),?20,$EXTRACT(RMPFITP,1,20),?42,$JUSTIFY(RMPFQTY,5)

 +4        SET CM=""

           DO COMP^RMPFDT3

           WRITE ?52,CM

           if $LENGTH(CM)>18

               WRITE !

 +5        WRITE ?72,$EXTRACT(RMPFLIS,1,8)

 +6        QUIT 

PRTQ       IF CX<2

               WRITE !

               if $DATA(RMPFEDIT)&($DATA(CN))

                   WRITE "[",CN,"]"

               WRITE ?8,"Hearing Aid Accessory",?36,"Quantity",?46,"Status",!,?4,"------------------------------",?36,"--------",?46,"------"

 +1        WRITE !,$JUSTIFY(CX,2)," ",?4,$EXTRACT(RMPFITP,1,30),?35,$JUSTIFY(RMPFQTY,9),?46,$EXTRACT(RMPFLIS,1,6)

 +2        QUIT 

PRTX       IF CX<2

               DO HEAD

               WRITE ?6,"Make",?21,"Model",?35,"Component",?47,"Comp Price",?59,"Ear",?64,"Status"

               SET RMPFTOT=0

               WRITE !?4,"--------",?14,"-------------------",?35,"----------",?47,"----------",?59,"---",?64,"------"

 +1        WRITE !,$JUSTIFY(CX,2)," ",?4,$EXTRACT(RMPFMAK,1,8),?14,$EXTRACT(RMPFITP,1,19)

 +2        SET X=0

           FOR K=1:1

               SET X=$ORDER(RMPFC(X))

               if 'X

                   QUIT 

               SET Y=$PIECE(RMPFC(X),U,1)

               IF Y

                   Begin DoDot:1

 +3                    if '$DATA(^RMPF(791811.2,Y,0))

                           QUIT 

                       SET S3=^(0)

 +4                    SET RMPFCOM=$PIECE(S3,U,3)

                       SET RMPFCOMC=$JUSTIFY($PIECE(RMPFC(X),U,2),0,2)

 +5                    SET RMPFTOT=RMPFTOT+RMPFCOMC

 +6                    if $X'>0

                           WRITE "(cont.)",!,$JUSTIFY(CX,2),". ",$EXTRACT(RMPFMAK,1,8),?18,$EXTRACT(RMPFITP,1,11),?27,$JUSTIFY(RMPFCOST,6)

 +7                    if CT

                           WRITE !

                       WRITE ?35,$EXTRACT(RMPFCOM,1,9),?47,$JUSTIFY(RMPFCOMC,10)

 +8                    if CT=0

                           WRITE ?56,RMPFISDP,?60,$EXTRACT(RMPFLR,1),?64,$EXTRACT(RMPFLIS,1,6)

 +9                    SET CT=CT+1

                   End DoDot:1

 +10       IF RMPFSN'=""

               WRITE !?4,"Serial Number: ",RMPFSN

 +11       IF RMPFCERU'=""

               if RMPFSN=""

                   WRITE !

               if $PIECE(^RMPF(791810,RMPFX,101,RMPFY,90),U,10)

                   WRITE ?32,"Re-"

               WRITE ?33,"Certified: ",RMPFCERD,?57,"By: ",$EXTRACT(RMPFCERU,1,19)

 +12       QUIT 

PRTN       IF CX<2

               Begin DoDot:1

 +1                WRITE !,?5,"Make",?14,"Model",?24,"Serial #",?35,"Iss Date",?45,"Battery",?53,"Type",?58,"Ear",?63,"Replace",?73,"Status"

 +2                WRITE !?3,"-------",?11,"-----------",?23,"----------",?34,"----------",?45,"-------",?53,"----",?58,"---",?62,"----------",?73,"------"

               End DoDot:1

 +3        WRITE !,$JUSTIFY(CX,2)," ",$EXTRACT(RMPFMAK,1,7),?11,$EXTRACT(RMPFITP,1,11),?23,RMPFSN,?34,RMPFISDP,?45,$EXTRACT(RMPFBAT,1,7),?53,$EXTRACT(RMPFISRE,1,4),?59,RMPFLR

 +4        IF $DATA(RMPFN)

               SET X=0

               FOR K=1:1

                   SET X=$ORDER(RMPFN(X))

                   if 'X

                       QUIT 

                   if CT>0

                       WRITE !

                   WRITE ?62,$EXTRACT(RMPFN(X),1,10)

                   if CT=0

                       WRITE ?73,$EXTRACT(RMPFLIS,1,6)

                   KILL RMPFLIS

                   SET CT=CT+1

 +5        IF $DATA(RMPFLIS)

               WRITE ?73,$EXTRACT(RMPFLIS,1,6)

 +6        QUIT 

PRTT       IF CX<2

               DO HEAD

               WRITE !?5,"Make",?17,"Model",?28,"Serial #",?48,"Type of Loss",?72,"Status",!?3,"---------",?14,"-----------",?27,"----------",?39,"-------------------------------",?72,"------"

 +1        WRITE !,$JUSTIFY(CX,2)," ",$EXTRACT(RMPFMAK,1,9),?14,$EXTRACT(RMPFITP,1,11),?27,RMPFSN,?39,RMPFTOL,?72,$EXTRACT(RMPFLIS,1,6)

 +2        QUIT 

PRTV       IF CX<2

               WRITE !?5,"Make",?19,"Model",?32,"Serial #",?43,"Recover Date",?57,"Ear",?62,"Status",!?3,"---------",?14,"---------------",?31,"----------",?43,"------------",?57,"---",?62,"------"

 +1        WRITE !,$JUSTIFY(CX,2)," ",$EXTRACT(RMPFMAK,1,9),?14,$EXTRACT(RMPFITP,1,15),?31,$EXTRACT(RMPFSN,1,10),?43,RMPFRED,?58,RMPFLR,?62,$EXTRACT(RMPFLIS,1,6)

 +2        QUIT 

PRTZ       IF CX<2

               if $DATA(RMPFEDIT)&$DATA(CN)

                   WRITE "[",CN,"]"

               Begin DoDot:1

 +1                WRITE ?59,"SC/",?70,"Spec"

 +2                WRITE !?10,"Prosthetic Item",?34,"Qty",?39,"Price",?46,"Typ",?50,"Disabil.",?59,"NSC",?63,"Categ.",?70,"Cat.",?75,"Stat."

 +3                WRITE !?3,"------------------------------",?34,"---",?38,"-------",?46,"---",?50,"--------",?59,"---",?63,"------",?70,"----",?75,"-----"

               End DoDot:1

 +4        if CX=0

               QUIT 

 +5        WRITE !,$JUSTIFY(CX,2)," ",$EXTRACT(RMPFITP,1,30),?34,$JUSTIFY(RMPFQTY,3),?38,$JUSTIFY((RMPFCOST*QT),7,2),?47,RMPFTT,?50,RMPFDIS,?60,RMPFDSN,?63,RMPFPCT,?70,RMPFPSC,?75,$EXTRACT(RMPFLIS,1,5)

 +6        QUIT 

PRTJ       IF CX<2

               if $DATA(RMPFEDIT)&($DATA(CN))

                   WRITE "[",CN,"]"

               WRITE !?11,"Prosthetic Item",?37,"Qty",?43,"Price",?51,"Status",!?3,"--------------------------------",?37,"---",?42,"-------",?51,"------"

 +1        if CX=0

               QUIT 

 +2        WRITE !,$JUSTIFY(CX,2)," ",$EXTRACT(RMPFITP,1,32),?37,$JUSTIFY(RMPFQTY,3),?42,$JUSTIFY((RMPFCOST*QT),7,2),?51,$EXTRACT(RMPFLIS,1,6)

 +3        QUIT 

HEAD       WRITE !

           if $DATA(RMPFEDIT)&$DATA(CN)

               WRITE "[",CN,"]"

 +1        QUIT 

LINE       WRITE !?4,"--------",?14,"-----------",?27,"------",?35,"----------",?47,"-------",?56,"--------",?66,"-"

           if RMPFHAT'="H"

               WRITE ?69,"-----------"

 +1        QUIT 

LINE1      WRITE !?3,"-------",?11,"---------------",?27,"------",?34,"----------",?45,"-------",?53,"----------",?64,"----------",?75,"-----"