RMPRN6XM ;Hines OIFO/HNC - NPPD Auto-Fix ;9/16/02 11:14
;;3.0;PROSTHETICS;**70,90**;Feb 09, 1996
Q
TASK ;main entry point
;look at file 660, field #2 Type.
;this will need to be updated with 1=new and 2=repair.
;
;"I" = initial issue = new
;"R" = replace = new
;"S" = spare = new
;"X" = repair = repair
; 5 = rental = repair added with patch 90
;
K ^TMP($J)
S B=0,LINE=""
F S B=$O(^RMPR(660,B)) Q:B'>0 D
.S TYPE=$P($G(^RMPR(660,B,0)),U,4)
.I TYPE=5 Q ;No change if Rental just quit.
.;if type is null, then Home Oxygen Posted with no type, and that is
.;a repair NPPD line. Or, shipping and that is repair.
.I TYPE="" S TYPE="X"
.S PHCPCS=$P($G(^RMPR(660,B,1)),U,4)
.;junk in the global - alpha
.Q:PHCPCS'>0
.Q:PHCPCS=""
.I TYPE'="X" S LINE=$P(^RMPR(661.1,PHCPCS,0),U,7)
.I LINE="" D
. .S ERR=""
. .S LINE=$P(^RMPR(661.1,PHCPCS,0),U,6)
. .S TYPE="X"
. .S DIE="^RMPR(660,",DA=B,DR="2///^S X=TYPE"
. .L +^RMPR(660,B):1 I '$T S ERR=1
. .W !,B," ",ERR
. .I ERR=1 S ^TMP($J,"RMPRA",B)="NO UPDATE!"
. .I ERR="" D ^DIE L -^RMPR(660,B)
. .K DIE,DA,DR
. .I ERR="" S ^TMP($J,"RMPRA",B)="NEW TO REPAIR"
. .D DATA
.I TYPE="X" S LINE=$P(^RMPR(661.1,PHCPCS,0),U,6)
.I LINE="" D
. .S ERR=""
. .S LINE=$P(^RMPR(661.1,PHCPCS,0),U,7)
. .S TYPE="I"
. .S DIE="^RMPR(660,",DA=B,DR="2///^S X=TYPE"
. .L +^RMPR(660,B):1 I '$T S ERR=1
. .I ERR=1 S ^TMP($J,"RMPRA",B)="NO UPDATE!"
. .I ERR="" D ^DIE L -^RMPR(660,B)
. .K DIE,DA,DR
. .I ERR="" S ^TMP($J,"RMPRA",B)="REPAIR TO NEW "
. .D DATA
K B,LINE,PHCPCS,TYPE
D FMT
I $D(^TMP($J,"RMPR")) D MAIL
G EXIT
Q
DATA ;delimited tmp with data
D GETS^DIQ(660,B,".01;.02;4.5;5;7;8.3;14;4;24;27","","RMXM")
S $P(^TMP($J,"RMPRA",B),U,2)=$G(RMXM(660,B_",",.01))
S $P(^TMP($J,"RMPRA",B),U,3)=$G(RMXM(660,B_",",.02))
S $P(^TMP($J,"RMPRA",B),U,4)=$G(RMXM(660,B_",",4.5))
S $P(^TMP($J,"RMPRA",B),U,5)=$G(RMXM(660,B_",",5))
S $P(^TMP($J,"RMPRA",B),U,6)=$G(RMXM(660,B_",",7))
S $P(^TMP($J,"RMPRA",B),U,7)=$G(RMXM(660,B_",",8.3))
S $P(^TMP($J,"RMPRA",B),U,8)=$G(RMXM(660,B_",",14))
S $P(^TMP($J,"RMPRA",B),U,9)=$G(RMXM(660,B_",",4))
S $P(^TMP($J,"RMPRA",B),U,10)=$G(RMXM(660,B_",",27))
S $P(^TMP($J,"RMPRA",B),U,11)=LINE
S $P(^TMP($J,"RMPRA",B),U,12)=$G(RMXM(660,B_",",24))
K RMXM
Q
FMT ;format the records for report display
S B=0,^TMP($J,"RMPRFMT")="",CNT=0
F S B=$O(^TMP($J,"RMPRA",B)) Q:B'>0 D
.S DATA=^TMP($J,"RMPRA",B)
.S (B1,BX,B3,B4,B5,B6,B7,B8)=""
.S B2="^TMP($J,""RMPRFMT"")"
.S B1=$$SETSTR^VALM1($P(DATA,U,1),@B2,1,14)
.S BX=$$SETSTR^VALM1($P(DATA,U,2),@B2,1,14)
.S B3=$$SETSTR^VALM1($P(DATA,U,3),@B2,1,11)
.S B4=$$SETSTR^VALM1($P(DATA,U,4),@B2,1,6)
.S B5=$$SETSTR^VALM1($P(DATA,U,9),@B2,1,10)
.S B6=$$SETSTR^VALM1($P(DATA,U,6),@B2,2,11)
.S B7=$$SETSTR^VALM1($P(DATA,U,10),@B2,2,12)
.S OLDLN=$P(DATA,U,1)
.I OLDLN["REPAIR TO NEW" S OLDLN="R99 X"
.I OLDLN["NEW TO REPAIR" S OLDLN="999 X"
.I OLDLN["NO UPDATE!" S OLDLN="????"
.;
.S CNT=CNT+1
.S ^TMP($J,"RMPR",CNT)=B1
.S CNT=CNT+1
.S ^TMP($J,"RMPR",CNT)="Create Date Patient HCPCS Item Vendor PA"
.S CNT=CNT+1
.S ^TMP($J,"RMPR",CNT)=BX_B3_B4_B8_B5_B6_B7
.S CNT=CNT+1
.S ^TMP($J,"RMPR",CNT)=""
.S CNT=CNT+1
.S ^TMP($J,"RMPR",CNT)="Brief Description: "_$P(DATA,U,12)
.S CNT=CNT+1
.S ^TMP($J,"RMPR",CNT)=""
.S CNT=CNT+1
.I OLDLN'="????" S ^TMP($J,"RMPR",CNT)="Changed From Line "_OLDLN_" To NPPD Line: "_$P(DATA,U,11)_" Local Record #:"_B
.I OLDLN="????" S ^TMP($J,"RMPR",CNT)="Nothing Changed, Someone Was Editing Record. Local Record #:"_B
.S CNT=CNT+1
.S ^TMP($J,"RMPR",CNT)="-------------------------------------------------------------------------------"
Q
;
MAIL ;send report via message to mail group RMPR INVENTORY
;
S XMY("G.RMPR INVENTORY")=""
S XMDUZ=.5
S XMTEXT="^TMP($J,""RMPR"","
S XMSUB="Prosthetics Auto-Fix"
D ^XMD
Q
;
EXIT ;common exit point
K ^TMP($J,"RMPRA"),^TMP($J,"RMPR")
Q
;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRN6XM 4087 printed Oct 16, 2024@18:35:51 Page 2
RMPRN6XM ;Hines OIFO/HNC - NPPD Auto-Fix ;9/16/02 11:14
+1 ;;3.0;PROSTHETICS;**70,90**;Feb 09, 1996
+2 QUIT
TASK ;main entry point
+1 ;look at file 660, field #2 Type.
+2 ;this will need to be updated with 1=new and 2=repair.
+3 ;
+4 ;"I" = initial issue = new
+5 ;"R" = replace = new
+6 ;"S" = spare = new
+7 ;"X" = repair = repair
+8 ; 5 = rental = repair added with patch 90
+9 ;
+10 KILL ^TMP($JOB)
+11 SET B=0
SET LINE=""
+12 FOR
SET B=$ORDER(^RMPR(660,B))
if B'>0
QUIT
Begin DoDot:1
+13 SET TYPE=$PIECE($GET(^RMPR(660,B,0)),U,4)
+14 ;No change if Rental just quit.
IF TYPE=5
QUIT
+15 ;if type is null, then Home Oxygen Posted with no type, and that is
+16 ;a repair NPPD line. Or, shipping and that is repair.
+17 IF TYPE=""
SET TYPE="X"
+18 SET PHCPCS=$PIECE($GET(^RMPR(660,B,1)),U,4)
+19 ;junk in the global - alpha
+20 if PHCPCS'>0
QUIT
+21 if PHCPCS=""
QUIT
+22 IF TYPE'="X"
SET LINE=$PIECE(^RMPR(661.1,PHCPCS,0),U,7)
+23 IF LINE=""
Begin DoDot:2
+24 SET ERR=""
+25 SET LINE=$PIECE(^RMPR(661.1,PHCPCS,0),U,6)
+26 SET TYPE="X"
+27 SET DIE="^RMPR(660,"
SET DA=B
SET DR="2///^S X=TYPE"
+28 LOCK +^RMPR(660,B):1
IF '$TEST
SET ERR=1
+29 WRITE !,B," ",ERR
+30 IF ERR=1
SET ^TMP($JOB,"RMPRA",B)="NO UPDATE!"
+31 IF ERR=""
DO ^DIE
LOCK -^RMPR(660,B)
+32 KILL DIE,DA,DR
+33 IF ERR=""
SET ^TMP($JOB,"RMPRA",B)="NEW TO REPAIR"
+34 DO DATA
End DoDot:2
+35 IF TYPE="X"
SET LINE=$PIECE(^RMPR(661.1,PHCPCS,0),U,6)
+36 IF LINE=""
Begin DoDot:2
+37 SET ERR=""
+38 SET LINE=$PIECE(^RMPR(661.1,PHCPCS,0),U,7)
+39 SET TYPE="I"
+40 SET DIE="^RMPR(660,"
SET DA=B
SET DR="2///^S X=TYPE"
+41 LOCK +^RMPR(660,B):1
IF '$TEST
SET ERR=1
+42 IF ERR=1
SET ^TMP($JOB,"RMPRA",B)="NO UPDATE!"
+43 IF ERR=""
DO ^DIE
LOCK -^RMPR(660,B)
+44 KILL DIE,DA,DR
+45 IF ERR=""
SET ^TMP($JOB,"RMPRA",B)="REPAIR TO NEW "
+46 DO DATA
End DoDot:2
End DoDot:1
+47 KILL B,LINE,PHCPCS,TYPE
+48 DO FMT
+49 IF $DATA(^TMP($JOB,"RMPR"))
DO MAIL
+50 GOTO EXIT
+51 QUIT
DATA ;delimited tmp with data
+1 DO GETS^DIQ(660,B,".01;.02;4.5;5;7;8.3;14;4;24;27","","RMXM")
+2 SET $PIECE(^TMP($JOB,"RMPRA",B),U,2)=$GET(RMXM(660,B_",",.01))
+3 SET $PIECE(^TMP($JOB,"RMPRA",B),U,3)=$GET(RMXM(660,B_",",.02))
+4 SET $PIECE(^TMP($JOB,"RMPRA",B),U,4)=$GET(RMXM(660,B_",",4.5))
+5 SET $PIECE(^TMP($JOB,"RMPRA",B),U,5)=$GET(RMXM(660,B_",",5))
+6 SET $PIECE(^TMP($JOB,"RMPRA",B),U,6)=$GET(RMXM(660,B_",",7))
+7 SET $PIECE(^TMP($JOB,"RMPRA",B),U,7)=$GET(RMXM(660,B_",",8.3))
+8 SET $PIECE(^TMP($JOB,"RMPRA",B),U,8)=$GET(RMXM(660,B_",",14))
+9 SET $PIECE(^TMP($JOB,"RMPRA",B),U,9)=$GET(RMXM(660,B_",",4))
+10 SET $PIECE(^TMP($JOB,"RMPRA",B),U,10)=$GET(RMXM(660,B_",",27))
+11 SET $PIECE(^TMP($JOB,"RMPRA",B),U,11)=LINE
+12 SET $PIECE(^TMP($JOB,"RMPRA",B),U,12)=$GET(RMXM(660,B_",",24))
+13 KILL RMXM
+14 QUIT
FMT ;format the records for report display
+1 SET B=0
SET ^TMP($JOB,"RMPRFMT")=""
SET CNT=0
+2 FOR
SET B=$ORDER(^TMP($JOB,"RMPRA",B))
if B'>0
QUIT
Begin DoDot:1
+3 SET DATA=^TMP($JOB,"RMPRA",B)
+4 SET (B1,BX,B3,B4,B5,B6,B7,B8)=""
+5 SET B2="^TMP($J,""RMPRFMT"")"
+6 SET B1=$$SETSTR^VALM1($PIECE(DATA,U,1),@B2,1,14)
+7 SET BX=$$SETSTR^VALM1($PIECE(DATA,U,2),@B2,1,14)
+8 SET B3=$$SETSTR^VALM1($PIECE(DATA,U,3),@B2,1,11)
+9 SET B4=$$SETSTR^VALM1($PIECE(DATA,U,4),@B2,1,6)
+10 SET B5=$$SETSTR^VALM1($PIECE(DATA,U,9),@B2,1,10)
+11 SET B6=$$SETSTR^VALM1($PIECE(DATA,U,6),@B2,2,11)
+12 SET B7=$$SETSTR^VALM1($PIECE(DATA,U,10),@B2,2,12)
+13 SET OLDLN=$PIECE(DATA,U,1)
+14 IF OLDLN["REPAIR TO NEW"
SET OLDLN="R99 X"
+15 IF OLDLN["NEW TO REPAIR"
SET OLDLN="999 X"
+16 IF OLDLN["NO UPDATE!"
SET OLDLN="????"
+17 ;
+18 SET CNT=CNT+1
+19 SET ^TMP($JOB,"RMPR",CNT)=B1
+20 SET CNT=CNT+1
+21 SET ^TMP($JOB,"RMPR",CNT)="Create Date Patient HCPCS Item Vendor PA"
+22 SET CNT=CNT+1
+23 SET ^TMP($JOB,"RMPR",CNT)=BX_B3_B4_B8_B5_B6_B7
+24 SET CNT=CNT+1
+25 SET ^TMP($JOB,"RMPR",CNT)=""
+26 SET CNT=CNT+1
+27 SET ^TMP($JOB,"RMPR",CNT)="Brief Description: "_$PIECE(DATA,U,12)
+28 SET CNT=CNT+1
+29 SET ^TMP($JOB,"RMPR",CNT)=""
+30 SET CNT=CNT+1
+31 IF OLDLN'="????"
SET ^TMP($JOB,"RMPR",CNT)="Changed From Line "_OLDLN_" To NPPD Line: "_$PIECE(DATA,U,11)_" Local Record #:"_B
+32 IF OLDLN="????"
SET ^TMP($JOB,"RMPR",CNT)="Nothing Changed, Someone Was Editing Record. Local Record #:"_B
+33 SET CNT=CNT+1
+34 SET ^TMP($JOB,"RMPR",CNT)="-------------------------------------------------------------------------------"
End DoDot:1
+35 QUIT
+36 ;
MAIL ;send report via message to mail group RMPR INVENTORY
+1 ;
+2 SET XMY("G.RMPR INVENTORY")=""
+3 SET XMDUZ=.5
+4 SET XMTEXT="^TMP($J,""RMPR"","
+5 SET XMSUB="Prosthetics Auto-Fix"
+6 DO ^XMD
+7 QUIT
+8 ;
EXIT ;common exit point
+1 KILL ^TMP($JOB,"RMPRA"),^TMP($JOB,"RMPR")
+2 QUIT
+3 ;END
