- RMPR29D ;PHX/JLT-DISPLAY 2529-3 INFO ;8/29/1994 [ 09/29/94 10:05 AM ]
- ;;3.0;PROSTHETICS;**12,41,77**;Feb 09, 1996
- ;RVD 3/18/03 patch #77 - prevent error in word processing field.
- DISP ;GET AND DISPLAY 2529-3 INFO
- ;CALLED BY:RMPR29,RMPR29A,RMPR29B,RMPR29C,RMPR29J,RMPR29P,RMPR29S,RMPR29T
- ;VARIABLES REQUIRED: RMPRDA - ENTRY IN FILE 664.
- D HOME^%ZIS K ^UTILITY("DIQ1",$J),HLD
- Q:$G(RMPRDA)'>0 S DIC="^RMPR(664.1,",DA=RMPRDA,DR=".02;.11;.04;.09;2;4;13;15;19"
- D EN^DIQ1 K DIQ,DR S PAGE=1
- S DA=RMPRDA
- F RI=0:0 S RI=$O(^RMPR(664.1,DA,2,RI)) Q:RI'>0 I $D(^(RI,0)) D
- .S DIC="^RMPR(664.1,",DR="6"
- .S DR(664.16)=".01;2;3;8;9;10;7;12;13;13.1",DA(664.16)=RI
- .S HLD(RI)=$$ITM1^RMPR31U($P(^RMPR(664.1,DA,2,RI,0),U))
- .D EN^DIQ1 K DIQ,DR
- I '$D(PNK) D HD^RMPR29W G ITD
- I $D(PNK) D HDC^RMPR29W G ITD
- G ASK^RMPR29T
- ITD ;ITEM DISPLAY
- ;CALLED BY RMPR29T
- ;VARIABLES REQUIRED: HLD - ARRAY OF ITEMS
- ; RI - ITEM NUMBER
- G:($Y+8>IOSL)!('$D(HLD)) ASK^RMPR29T
- S RI=$O(HLD(0))
- W !,HLD(RI),?10,$E(^UTILITY("DIQ1",$J,664.16,RI,.01),1,15)
- W ?27,$E(^UTILITY("DIQ1",$J,664.16,RI,12),1,15),?45,^(2),?50,^(3),?55,^(8),?65,^(9)
- ;HCPCS Display
- W !,?10,"HCPCS: ",^UTILITY("DIQ1",$J,664.16,RI,13)
- W !,?10,"CPT MODIFIER: ",^UTILITY("DIQ1",$J,664.16,RI,13.1)
- WP ;WORD PROCESSING FIELD DISPLAY
- G:($Y+8>IOSL) ASK^RMPR29T S RWP=$O(^UTILITY("DIQ1",$J,664.16,RI,7,0))
- I RWP'>0 K HLD(RI) K D0 D ADC^RMPR293(RMPRDA,RI) W ! G ITD
- S X=$G(^UTILITY("DIQ1",$J,664.16,RI,7,RWP))
- K ^UTILITY("DIQ1",$J,664.16,RI,7,RWP)
- K ^UTILITY($J) S DIWL=1,DIWR=60,DIWF="R" D ^DIWP
- EXT ;COMMON EXIT POINT
- ;CALLED BY RMPR29T
- ;VARIABLES REQUIRED: - UTILITY GLOBAL CONTAINING INFO TO PRINT AND KILL.
- G:($Y+8>IOSL)!'$D(DIWL) ASK^RMPR29T
- S RL=$O(^UTILITY($J,"W",DIWL,0)) I +RL W !,?10,^(RL,0) K ^(0) G EXT
- K ^UTILITY($J) G WP
- CHK ;CHECK DISABILITY AND ITEMS
- ;kill record if not all mandatory fields defined
- ;CALLED BY RMPR29T,RMPR29
- ;VARIABLES REQUIRED: RMPRDA - ENTRY NUMBER IN FILE 664.1
- K RKILL
- F RCK=1,2,3,4,11,15 I $P(^RMPR(664.1,RMPRDA,0),U,RCK)="" S RKILL=1 S DA=RMPRDA,DIK="^RMPR(664.1," D ^DIK W !!,?5,$C(7),"ALL MANDATORY FIELDS NOT DEFINED FORM 2529-3 DELETED" Q
- I $D(RKILL) G EXIT^RMPR29
- ;disability code missing
- K DKILL
- I '$D(^RMPR(664.1,RMPRDA,1))!('$O(^RMPR(664.1,RMPRDA,1,0))) S DKILL=1
- F RI=0:0 S RI=$O(^RMPR(664.1,RMPRDA,1,RI)) Q:RI'>0 I $P(^(RI,0),U,1)=""!($P(^(0),U,2)="") S DKILL=1
- ;item missing
- K IKILL
- I '$D(^RMPR(664.1,RMPRDA,2))!('$O(^RMPR(664.1,RMPRDA,2,0))) S IKILL=1
- F RI=0:0 S RI=$O(^RMPR(664.1,RMPRDA,2,RI)) Q:RI'>0 I $P(^(RI,0),U,1)=""!($P(^(0),U,2)="")!($P(^(0),U,3)="")!($P(^(0),U,7)="")!($P(^(0),U,8)="") S IKILL=1
- ER1 ;error message
- I $D(DKILL) W $C(7),!!,?5,"2529-3 FORM INCOMPLETE. DISABILITY CODE INFORMATION IS MISSING!!"
- I $D(IKILL) W $C(7),!!,?5,"2529-3 FORM INCOMPLETE. ITEM INFORMATION IS MISSING!!"
- I $D(IKILL)!($D(DKILL)) G DEL^RMPR29
- ;see internal notes
- K DA,DIC,DIK,DIWF,DIWL,DIWR,PAGE,PNK,RCK,RI,RL,RWP,X
- G LAB^RMPR29
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR29D 3035 printed Feb 18, 2025@23:58:37 Page 2
- RMPR29D ;PHX/JLT-DISPLAY 2529-3 INFO ;8/29/1994 [ 09/29/94 10:05 AM ]
- +1 ;;3.0;PROSTHETICS;**12,41,77**;Feb 09, 1996
- +2 ;RVD 3/18/03 patch #77 - prevent error in word processing field.
- DISP ;GET AND DISPLAY 2529-3 INFO
- +1 ;CALLED BY:RMPR29,RMPR29A,RMPR29B,RMPR29C,RMPR29J,RMPR29P,RMPR29S,RMPR29T
- +2 ;VARIABLES REQUIRED: RMPRDA - ENTRY IN FILE 664.
- +3 DO HOME^%ZIS
- KILL ^UTILITY("DIQ1",$JOB),HLD
- +4 if $GET(RMPRDA)'>0
- QUIT
- SET DIC="^RMPR(664.1,"
- SET DA=RMPRDA
- SET DR=".02;.11;.04;.09;2;4;13;15;19"
- +5 DO EN^DIQ1
- KILL DIQ,DR
- SET PAGE=1
- +6 SET DA=RMPRDA
- +7 FOR RI=0:0
- SET RI=$ORDER(^RMPR(664.1,DA,2,RI))
- if RI'>0
- QUIT
- IF $DATA(^(RI,0))
- Begin DoDot:1
- +8 SET DIC="^RMPR(664.1,"
- SET DR="6"
- +9 SET DR(664.16)=".01;2;3;8;9;10;7;12;13;13.1"
- SET DA(664.16)=RI
- +10 SET HLD(RI)=$$ITM1^RMPR31U($PIECE(^RMPR(664.1,DA,2,RI,0),U))
- +11 DO EN^DIQ1
- KILL DIQ,DR
- End DoDot:1
- +12 IF '$DATA(PNK)
- DO HD^RMPR29W
- GOTO ITD
- +13 IF $DATA(PNK)
- DO HDC^RMPR29W
- GOTO ITD
- +14 GOTO ASK^RMPR29T
- ITD ;ITEM DISPLAY
- +1 ;CALLED BY RMPR29T
- +2 ;VARIABLES REQUIRED: HLD - ARRAY OF ITEMS
- +3 ; RI - ITEM NUMBER
- +4 if ($Y+8>IOSL)!('$DATA(HLD))
- GOTO ASK^RMPR29T
- +5 SET RI=$ORDER(HLD(0))
- +6 WRITE !,HLD(RI),?10,$EXTRACT(^UTILITY("DIQ1",$JOB,664.16,RI,.01),1,15)
- +7 WRITE ?27,$EXTRACT(^UTILITY("DIQ1",$JOB,664.16,RI,12),1,15),?45,^(2),?50,^(3),?55,^(8),?65,^(9)
- +8 ;HCPCS Display
- +9 WRITE !,?10,"HCPCS: ",^UTILITY("DIQ1",$JOB,664.16,RI,13)
- +10 WRITE !,?10,"CPT MODIFIER: ",^UTILITY("DIQ1",$JOB,664.16,RI,13.1)
- WP ;WORD PROCESSING FIELD DISPLAY
- +1 if ($Y+8>IOSL)
- GOTO ASK^RMPR29T
- SET RWP=$ORDER(^UTILITY("DIQ1",$JOB,664.16,RI,7,0))
- +2 IF RWP'>0
- KILL HLD(RI)
- KILL D0
- DO ADC^RMPR293(RMPRDA,RI)
- WRITE !
- GOTO ITD
- +3 SET X=$GET(^UTILITY("DIQ1",$JOB,664.16,RI,7,RWP))
- +4 KILL ^UTILITY("DIQ1",$JOB,664.16,RI,7,RWP)
- +5 KILL ^UTILITY($JOB)
- SET DIWL=1
- SET DIWR=60
- SET DIWF="R"
- DO ^DIWP
- EXT ;COMMON EXIT POINT
- +1 ;CALLED BY RMPR29T
- +2 ;VARIABLES REQUIRED: - UTILITY GLOBAL CONTAINING INFO TO PRINT AND KILL.
- +3 if ($Y+8>IOSL)!'$DATA(DIWL)
- GOTO ASK^RMPR29T
- +4 SET RL=$ORDER(^UTILITY($JOB,"W",DIWL,0))
- IF +RL
- WRITE !,?10,^(RL,0)
- KILL ^(0)
- GOTO EXT
- +5 KILL ^UTILITY($JOB)
- GOTO WP
- CHK ;CHECK DISABILITY AND ITEMS
- +1 ;kill record if not all mandatory fields defined
- +2 ;CALLED BY RMPR29T,RMPR29
- +3 ;VARIABLES REQUIRED: RMPRDA - ENTRY NUMBER IN FILE 664.1
- +4 KILL RKILL
- +5 FOR RCK=1,2,3,4,11,15
- IF $PIECE(^RMPR(664.1,RMPRDA,0),U,RCK)=""
- SET RKILL=1
- SET DA=RMPRDA
- SET DIK="^RMPR(664.1,"
- DO ^DIK
- WRITE !!,?5,$CHAR(7),"ALL MANDATORY FIELDS NOT DEFINED FORM 2529-3 DELETED"
- QUIT
- +6 IF $DATA(RKILL)
- GOTO EXIT^RMPR29
- +7 ;disability code missing
- +8 KILL DKILL
- +9 IF '$DATA(^RMPR(664.1,RMPRDA,1))!('$ORDER(^RMPR(664.1,RMPRDA,1,0)))
- SET DKILL=1
- +10 FOR RI=0:0
- SET RI=$ORDER(^RMPR(664.1,RMPRDA,1,RI))
- if RI'>0
- QUIT
- IF $PIECE(^(RI,0),U,1)=""!($PIECE(^(0),U,2)="")
- SET DKILL=1
- +11 ;item missing
- +12 KILL IKILL
- +13 IF '$DATA(^RMPR(664.1,RMPRDA,2))!('$ORDER(^RMPR(664.1,RMPRDA,2,0)))
- SET IKILL=1
- +14 FOR RI=0:0
- SET RI=$ORDER(^RMPR(664.1,RMPRDA,2,RI))
- if RI'>0
- QUIT
- IF $PIECE(^(RI,0),U,1)=""!($PIECE(^(0),U,2)="")!($PIECE(^(0),U,3)="")!($PIECE(^(0),U,7)="")!($PIECE(^(0),U,8)="")
- SET IKILL=1
- ER1 ;error message
- +1 IF $DATA(DKILL)
- WRITE $CHAR(7),!!,?5,"2529-3 FORM INCOMPLETE. DISABILITY CODE INFORMATION IS MISSING!!"
- +2 IF $DATA(IKILL)
- WRITE $CHAR(7),!!,?5,"2529-3 FORM INCOMPLETE. ITEM INFORMATION IS MISSING!!"
- +3 IF $DATA(IKILL)!($DATA(DKILL))
- GOTO DEL^RMPR29
- +4 ;see internal notes
- +5 KILL DA,DIC,DIK,DIWF,DIWL,DIWR,PAGE,PNK,RCK,RI,RL,RWP,X
- +6 GOTO LAB^RMPR29