RMPVS925 ; OIT/JDA - SCAMP runtime support; Nov 17, 2024@23:35:37
;;1.0;PROSTHETICS VISION 4 SIGHT II;**2**;Jan 31, 2025;Build 38
;
; Reference to file #660 supported by ICR #6496
; Reference to file 661.6, supported by ICR #6778
;
Q
TEST ;test tag
;TSTART
N REQ,RESP
S REQ("appliance_repair_ien")=1219548
S REQ("charge_id")=1234567890
S REQ("barcode_key")="V2100-3240916104909"
S REQ("barcode_key")="V2300-3240916095721" ; asks cwto edit CPT modifier
D RUN(.REQ,.RESP)
;zw RESP ; do TRO when finished
Q
TEST2 ;test tag
;TSTART
N REQ,RESP
;
S REQ("consult_ien")=1036764
S REQ("patient_ssn")=282459862
S REQ("inventory_location")="LOVELAND CLINIC"
S REQ("barcode_key")="A4565-3250219164758"
S REQ("quantity")=1
S REQ("remarks")="Feb 19, 2025"
S REQ("appliance_repair_ien")="1444242"
S REQ("type_of_transaction")="I"
S REQ("patient_category")="4"
S REQ("special_category")="4"
S REQ("charge_id")="5223a3b8-64e6-4419-9e2f-0bbd35cbf76b"
;
D RUN(.REQ,.RESP)
;zw RESP ; do TRO when finished
Q
RUN(REQUEST,RESPONSE) ; set up input/output vars and run
K ^TMP("RMPV",$J)
S ^TMP("RMPV",$J,"OUT","http_response","http_status_code")=200
S ^TMP("RMPV",$J,"OUT","http_response","message")=""
I ($G(REQUEST("charge_id"))'="") S ^TMP("RMPV",$J,"OUT","charge_id")=REQUEST("charge_id")
I ($G(REQUEST("consult_ien"))'="") S ^TMP("RMPV",$J,"OUT","consult_ien")=REQUEST("consult_ien")
N APPIEN S APPIEN=REQUEST("appliance_repair_ien")
S ^TMP("RMPV",$J,"OUT","appliance_repair_ien")=APPIEN
I '$D(^RMPR(660,APPIEN)) D ERROR(APPIEN_" is not a valid appliance repair IEN")
D:'$$ISERROR LOADVARS(.REQUEST)
;
D:'$$ISERROR RUN^RMPVDRV("^RMPV0RMPRPIYE",$T(+0))
;
D:'$$ISERROR FIND6616
M RESPONSE=^TMP("RMPV",$J,"OUT")
K ^TMP("RMPV",$J)
Q
ERROR(MSG) ; Set error return
S ^TMP("RMPV",$J,"OUT","http_response","message")=MSG
S ^TMP("RMPV",$J,"OUT","http_response","http_status_code")=422
Q
ISERROR() ; If error, simulate up-arrow and return 1
Q:^TMP("RMPV",$J,"OUT","http_response","http_status_code")=200 0
S (X,Y)="^",DUOUT=""
Q 1
LOADVARS(REQUEST) ; Load input variables into globals
M ^TMP("RMPV",$J,"IN")=REQUEST
; Optional input
D SETDFLT("quantity",1)
D SETDFLT("serial_number","")
D SETDFLT("lot_number","")
D SETDFLT("remarks","")
D SETDFLT("type_of_transaction","I")
D SETDFLT("patient_category",4)
D SETDFLT("special_category",4)
Q
SETDFLT(PROP,DFLT) ; Set defaults
S ^TMP("RMPV",$J,"IN",PROP)=$G(^TMP("RMPV",$J,"IN",PROP),DFLT)
Q
FIND6616 ; Find the new record in file 661.6
S HCPCS=^TMP("RMPV","$J","DATA","orig hcpcs")
; Go through new 661.6 IENS looking for a HCPCS match
N IEN S IEN=^TMP("RMPV",$J,"DATA","661.6 ien")
F S IEN=$O(^RMPR(661.6,IEN)) Q:'IEN D Q:$D(^TMP("RMPV",$J,"OUT","transaction_type"))
.I HCPCS'="unknown" Q:$P(^RMPR(661.6,IEN,0),U)'=HCPCS
.S ^TMP("RMPV",$J,"OUT","transaction_type")=$P(^RMPR(661.6,IEN,0),U,4)
D:'$D(^TMP("RMPV",$J,"OUT","transaction_type")) ERROR("Could not find new 661.6 record")
Q
INIT ; Initialization
S IOF="""""",IOM=80
S ^TMP("RMPV",$J,"DATA","661.6 ien")=$O(^RMPR(661.6,"%"),-1)
N ISSUE S ISSUE=$P(^RMPR(660,^TMP("RMPV",$J,"IN","appliance_repair_ien"),1),U,5)
I ISSUE'="" S ^TMP("RMPV","$J","DATA","orig hcpcs")=$P(^RMPR(661.6,ISSUE,0),U)
E S ^TMP("RMPV","$J","DATA","orig hcpcs")="unknown"
S ^TMP($J,"RMPV","CB","EN+5^RMPRPIYE")="GET660^RMPVS925"
S ^TMP($J,"RMPV","CB","DEL+2^RMPRPIYE")="DELED^RMPVS925"
S ^TMP($J,"RMPV","CB","EDU+2^RMPRPIYE")="TRAN^RMPVS925"
S ^TMP($J,"RMPV","CB","EDU+3^RMPRPIYE")="PCAT^RMPVS925"
S ^TMP($J,"RMPV","CB","EDU+5^RMPRPIYE")="SPE^RMPVS925"
S ^TMP($J,"RMPV","CB","BARC1^RMPRPIYS")="BARC1^RMPVS925"
S ^TMP($J,"RMPV","CB","CPT+12^RMPRPIYS")="CPT^RMPVS925"
S ^TMP($J,"RMPV","CB","VEN0+7^RMPRPIYE")="VEND^RMPVS925"
S ^TMP($J,"RMPV","CB","SOURCE+2^RMPRPIYE")="SOURCE^RMPVS925"
S ^TMP($J,"RMPV","CB","QTY+2^RMPRPIYE")="QTY^RMPVS925"
S ^TMP($J,"RMPV","CB","DATE^RMPRPIYF")="DATESERV^RMPVS925"
S ^TMP($J,"RMPV","CB","REQ^RMPRPIYF")="SER^RMPVS925"
S ^TMP($J,"RMPV","CB","LOT^RMPRPIYF")="LOT^RMPVS925"
S ^TMP($J,"RMPV","CB","REMA^RMPRPIYF")="REMA^RMPVS925"
S ^TMP($J,"RMPV","CB","EDX+3^RMPRPIYE")="POST^RMPVS925"
S ^TMP($J,"RMPV","CB","DIV4+7^RMPRSIT")="SITE^RMPVS925"
Q
;
GET660 ; Select appliance repair IEN
S Y=^TMP("RMPV",$J,"IN","appliance_repair_ien"),X="`"_Y
Q
DELED ; Delete or edit
S (Y,X)="E"
Q
TRAN ; Transaction type
S (X,Y)=^TMP("RMPV",$J,"IN","type_of_transaction")
Q
PCAT ; Patient category
S X=4,Y=4,Y(0)="NSC/OP"
Q
SPE ; Special category
S X=4,Y=4,Y(0)="ELIGIBILITY REFORM"
Q
BARC1 ; Barcode
Q:$$ISERROR
S (X,Y)=^TMP("RMPV",$J,"IN","barcode_key")
Q
CPT ; Edit CPT prompt
S X="N",Y=0
Q
VEND ; Vendor
S (X,Y)=$G(DIC("B"))
Q
SOURCE ; Source
S (X,Y)="C"
Q
QTY ; Quantity
S (X,Y)=^TMP("RMPV",$J,"IN","quantity")
Q
DATESERV ; Date of service
S %DT="",X="T"
D ^%DT
Q
SER ; Serial number
S (X,Y)=^TMP("RMPV",$J,"IN","serial_number")
Q
LOT ; Lot number
S (X,Y)=^TMP("RMPV",$J,"IN","lot_number")
Q
REMA ; Remarks
S (X,Y)=^TMP("RMPV",$J,"IN","remarks")
Q
POST ; Post
Q:$$ISERROR
S (X,Y)="P"
Q
;
SITE ; Site selection (669.9) "DIV+4^RMPRSIT"
N X,DIC,INSTIEN
S X=^TMP("RMPV",$J,"IN","inventory_location")
S DIC="^RMPR(661.5,",DIC(0)="OZ" D ^DIC
I Y'=-1,$D(Y)=11 D
. S INSTIEN=$P(Y(0),U,2)
. K Y
. I $D(^RMPR(669.9,"C",INSTIEN)) S Y=$O(^RMPR(669.9,"C",INSTIEN,""))
. E S Y=-1 D ERROR("Institution not found in PROSTHETICS SITE PARAMETERS file.") Q
E D ERROR(^TMP("RMPV",$J,"IN","inventory_location")_" is not a valid Inventory Location.") Q
Q
;
%WRITE(EREF,ARG) ; WRITE handler
I ARG["The Item scanned is not available" D Q
.D ERROR(^TMP("RMPV",$J,"IN","barcode_key")_" is not found in VISTA or is not in stock. Check Inventory Levels.") Q
I ARG["Issue quantity exceeds on-hand" D Q
.D ERROR(^TMP("RMPV",$J,"IN","barcode_key")_" has insufficient quantity to complete this transaction.") Q
;
I ARG["A problem has occurred with the scan, please try again." D Q
.D ERROR("Invalid Inventory Item/Location") Q
;
;I ARG["** No HCPCS Selected or Unable to Select Inactive HCPCS" D Q
;.D ERROR(^TMP("RMPV",$J,"IN","barcode_key")_" barcode contains an invalid HCPCS.") Q
Q
;
; Generator tags
%EREF() ; original entry point
Q "^RMPRPIYE"
%FOLLOW(TAG,ROUTINE) ; Should generator follow calls to tag^routine
I TAG="CPT",ROUTINE="RMPRPIYS" Q 0
I TAG="DEL1",ROUTINE="RMPRPIYE" Q 0
I TAG="DEL1",ROUTINE="RMPRPIYF" Q 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPVS925 6620 printed May 25, 2026@12:51:06 Page 2
RMPVS925 ; OIT/JDA - SCAMP runtime support; Nov 17, 2024@23:35:37
+1 ;;1.0;PROSTHETICS VISION 4 SIGHT II;**2**;Jan 31, 2025;Build 38
+2 ;
+3 ; Reference to file #660 supported by ICR #6496
+4 ; Reference to file 661.6, supported by ICR #6778
+5 ;
+6 QUIT
TEST ;test tag
+1 ;TSTART
+2 NEW REQ,RESP
+3 SET REQ("appliance_repair_ien")=1219548
+4 SET REQ("charge_id")=1234567890
+5 SET REQ("barcode_key")="V2100-3240916104909"
+6 ; asks cwto edit CPT modifier
SET REQ("barcode_key")="V2300-3240916095721"
+7 DO RUN(.REQ,.RESP)
+8 ;zw RESP ; do TRO when finished
+9 QUIT
TEST2 ;test tag
+1 ;TSTART
+2 NEW REQ,RESP
+3 ;
+4 SET REQ("consult_ien")=1036764
+5 SET REQ("patient_ssn")=282459862
+6 SET REQ("inventory_location")="LOVELAND CLINIC"
+7 SET REQ("barcode_key")="A4565-3250219164758"
+8 SET REQ("quantity")=1
+9 SET REQ("remarks")="Feb 19, 2025"
+10 SET REQ("appliance_repair_ien")="1444242"
+11 SET REQ("type_of_transaction")="I"
+12 SET REQ("patient_category")="4"
+13 SET REQ("special_category")="4"
+14 SET REQ("charge_id")="5223a3b8-64e6-4419-9e2f-0bbd35cbf76b"
+15 ;
+16 DO RUN(.REQ,.RESP)
+17 ;zw RESP ; do TRO when finished
+18 QUIT
RUN(REQUEST,RESPONSE) ; set up input/output vars and run
+1 KILL ^TMP("RMPV",$JOB)
+2 SET ^TMP("RMPV",$JOB,"OUT","http_response","http_status_code")=200
+3 SET ^TMP("RMPV",$JOB,"OUT","http_response","message")=""
+4 IF ($GET(REQUEST("charge_id"))'="")
SET ^TMP("RMPV",$JOB,"OUT","charge_id")=REQUEST("charge_id")
+5 IF ($GET(REQUEST("consult_ien"))'="")
SET ^TMP("RMPV",$JOB,"OUT","consult_ien")=REQUEST("consult_ien")
+6 NEW APPIEN
SET APPIEN=REQUEST("appliance_repair_ien")
+7 SET ^TMP("RMPV",$JOB,"OUT","appliance_repair_ien")=APPIEN
+8 IF '$DATA(^RMPR(660,APPIEN))
DO ERROR(APPIEN_" is not a valid appliance repair IEN")
+9 if '$$ISERROR
DO LOADVARS(.REQUEST)
+10 ;
+11 if '$$ISERROR
DO RUN^RMPVDRV("^RMPV0RMPRPIYE",$TEXT(+0))
+12 ;
+13 if '$$ISERROR
DO FIND6616
+14 MERGE RESPONSE=^TMP("RMPV",$JOB,"OUT")
+15 KILL ^TMP("RMPV",$JOB)
+16 QUIT
ERROR(MSG) ; Set error return
+1 SET ^TMP("RMPV",$JOB,"OUT","http_response","message")=MSG
+2 SET ^TMP("RMPV",$JOB,"OUT","http_response","http_status_code")=422
+3 QUIT
ISERROR() ; If error, simulate up-arrow and return 1
+1 if ^TMP("RMPV",$JOB,"OUT","http_response","http_status_code")=200
QUIT 0
+2 SET (X,Y)="^"
SET DUOUT=""
+3 QUIT 1
LOADVARS(REQUEST) ; Load input variables into globals
+1 MERGE ^TMP("RMPV",$JOB,"IN")=REQUEST
+2 ; Optional input
+3 DO SETDFLT("quantity",1)
+4 DO SETDFLT("serial_number","")
+5 DO SETDFLT("lot_number","")
+6 DO SETDFLT("remarks","")
+7 DO SETDFLT("type_of_transaction","I")
+8 DO SETDFLT("patient_category",4)
+9 DO SETDFLT("special_category",4)
+10 QUIT
SETDFLT(PROP,DFLT) ; Set defaults
+1 SET ^TMP("RMPV",$JOB,"IN",PROP)=$GET(^TMP("RMPV",$JOB,"IN",PROP),DFLT)
+2 QUIT
FIND6616 ; Find the new record in file 661.6
+1 SET HCPCS=^TMP("RMPV","$J","DATA","orig hcpcs")
+2 ; Go through new 661.6 IENS looking for a HCPCS match
+3 NEW IEN
SET IEN=^TMP("RMPV",$JOB,"DATA","661.6 ien")
+4 FOR
SET IEN=$ORDER(^RMPR(661.6,IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 IF HCPCS'="unknown"
if $PIECE(^RMPR(661.6,IEN,0),U)'=HCPCS
QUIT
+6 SET ^TMP("RMPV",$JOB,"OUT","transaction_type")=$PIECE(^RMPR(661.6,IEN,0),U,4)
End DoDot:1
if $DATA(^TMP("RMPV",$JOB,"OUT","transaction_type"))
QUIT
+7 if '$DATA(^TMP("RMPV",$JOB,"OUT","transaction_type"))
DO ERROR("Could not find new 661.6 record")
+8 QUIT
INIT ; Initialization
+1 SET IOF=""""""
SET IOM=80
+2 SET ^TMP("RMPV",$JOB,"DATA","661.6 ien")=$ORDER(^RMPR(661.6,"%"),-1)
+3 NEW ISSUE
SET ISSUE=$PIECE(^RMPR(660,^TMP("RMPV",$JOB,"IN","appliance_repair_ien"),1),U,5)
+4 IF ISSUE'=""
SET ^TMP("RMPV","$J","DATA","orig hcpcs")=$PIECE(^RMPR(661.6,ISSUE,0),U)
+5 IF '$TEST
SET ^TMP("RMPV","$J","DATA","orig hcpcs")="unknown"
+6 SET ^TMP($JOB,"RMPV","CB","EN+5^RMPRPIYE")="GET660^RMPVS925"
+7 SET ^TMP($JOB,"RMPV","CB","DEL+2^RMPRPIYE")="DELED^RMPVS925"
+8 SET ^TMP($JOB,"RMPV","CB","EDU+2^RMPRPIYE")="TRAN^RMPVS925"
+9 SET ^TMP($JOB,"RMPV","CB","EDU+3^RMPRPIYE")="PCAT^RMPVS925"
+10 SET ^TMP($JOB,"RMPV","CB","EDU+5^RMPRPIYE")="SPE^RMPVS925"
+11 SET ^TMP($JOB,"RMPV","CB","BARC1^RMPRPIYS")="BARC1^RMPVS925"
+12 SET ^TMP($JOB,"RMPV","CB","CPT+12^RMPRPIYS")="CPT^RMPVS925"
+13 SET ^TMP($JOB,"RMPV","CB","VEN0+7^RMPRPIYE")="VEND^RMPVS925"
+14 SET ^TMP($JOB,"RMPV","CB","SOURCE+2^RMPRPIYE")="SOURCE^RMPVS925"
+15 SET ^TMP($JOB,"RMPV","CB","QTY+2^RMPRPIYE")="QTY^RMPVS925"
+16 SET ^TMP($JOB,"RMPV","CB","DATE^RMPRPIYF")="DATESERV^RMPVS925"
+17 SET ^TMP($JOB,"RMPV","CB","REQ^RMPRPIYF")="SER^RMPVS925"
+18 SET ^TMP($JOB,"RMPV","CB","LOT^RMPRPIYF")="LOT^RMPVS925"
+19 SET ^TMP($JOB,"RMPV","CB","REMA^RMPRPIYF")="REMA^RMPVS925"
+20 SET ^TMP($JOB,"RMPV","CB","EDX+3^RMPRPIYE")="POST^RMPVS925"
+21 SET ^TMP($JOB,"RMPV","CB","DIV4+7^RMPRSIT")="SITE^RMPVS925"
+22 QUIT
+23 ;
GET660 ; Select appliance repair IEN
+1 SET Y=^TMP("RMPV",$JOB,"IN","appliance_repair_ien")
SET X="`"_Y
+2 QUIT
DELED ; Delete or edit
+1 SET (Y,X)="E"
+2 QUIT
TRAN ; Transaction type
+1 SET (X,Y)=^TMP("RMPV",$JOB,"IN","type_of_transaction")
+2 QUIT
PCAT ; Patient category
+1 SET X=4
SET Y=4
SET Y(0)="NSC/OP"
+2 QUIT
SPE ; Special category
+1 SET X=4
SET Y=4
SET Y(0)="ELIGIBILITY REFORM"
+2 QUIT
BARC1 ; Barcode
+1 if $$ISERROR
QUIT
+2 SET (X,Y)=^TMP("RMPV",$JOB,"IN","barcode_key")
+3 QUIT
CPT ; Edit CPT prompt
+1 SET X="N"
SET Y=0
+2 QUIT
VEND ; Vendor
+1 SET (X,Y)=$GET(DIC("B"))
+2 QUIT
SOURCE ; Source
+1 SET (X,Y)="C"
+2 QUIT
QTY ; Quantity
+1 SET (X,Y)=^TMP("RMPV",$JOB,"IN","quantity")
+2 QUIT
DATESERV ; Date of service
+1 SET %DT=""
SET X="T"
+2 DO ^%DT
+3 QUIT
SER ; Serial number
+1 SET (X,Y)=^TMP("RMPV",$JOB,"IN","serial_number")
+2 QUIT
LOT ; Lot number
+1 SET (X,Y)=^TMP("RMPV",$JOB,"IN","lot_number")
+2 QUIT
REMA ; Remarks
+1 SET (X,Y)=^TMP("RMPV",$JOB,"IN","remarks")
+2 QUIT
POST ; Post
+1 if $$ISERROR
QUIT
+2 SET (X,Y)="P"
+3 QUIT
+4 ;
SITE ; Site selection (669.9) "DIV+4^RMPRSIT"
+1 NEW X,DIC,INSTIEN
+2 SET X=^TMP("RMPV",$JOB,"IN","inventory_location")
+3 SET DIC="^RMPR(661.5,"
SET DIC(0)="OZ"
DO ^DIC
+4 IF Y'=-1
IF $DATA(Y)=11
Begin DoDot:1
+5 SET INSTIEN=$PIECE(Y(0),U,2)
+6 KILL Y
+7 IF $DATA(^RMPR(669.9,"C",INSTIEN))
SET Y=$ORDER(^RMPR(669.9,"C",INSTIEN,""))
+8 IF '$TEST
SET Y=-1
DO ERROR("Institution not found in PROSTHETICS SITE PARAMETERS file.")
QUIT
End DoDot:1
+9 IF '$TEST
DO ERROR(^TMP("RMPV",$JOB,"IN","inventory_location")_" is not a valid Inventory Location.")
QUIT
+10 QUIT
+11 ;
%WRITE(EREF,ARG) ; WRITE handler
+1 IF ARG["The Item scanned is not available"
Begin DoDot:1
+2 DO ERROR(^TMP("RMPV",$JOB,"IN","barcode_key")_" is not found in VISTA or is not in stock. Check Inventory Levels.")
QUIT
End DoDot:1
QUIT
+3 IF ARG["Issue quantity exceeds on-hand"
Begin DoDot:1
+4 DO ERROR(^TMP("RMPV",$JOB,"IN","barcode_key")_" has insufficient quantity to complete this transaction.")
QUIT
End DoDot:1
QUIT
+5 ;
+6 IF ARG["A problem has occurred with the scan, please try again."
Begin DoDot:1
+7 DO ERROR("Invalid Inventory Item/Location")
QUIT
End DoDot:1
QUIT
+8 ;
+9 ;I ARG["** No HCPCS Selected or Unable to Select Inactive HCPCS" D Q
+10 ;.D ERROR(^TMP("RMPV",$J,"IN","barcode_key")_" barcode contains an invalid HCPCS.") Q
+11 QUIT
+12 ;
+13 ; Generator tags
%EREF() ; original entry point
+1 QUIT "^RMPRPIYE"
%FOLLOW(TAG,ROUTINE) ; Should generator follow calls to tag^routine
+1 IF TAG="CPT"
IF ROUTINE="RMPRPIYS"
QUIT 0
+2 IF TAG="DEL1"
IF ROUTINE="RMPRPIYE"
QUIT 0
+3 IF TAG="DEL1"
IF ROUTINE="RMPRPIYF"
QUIT 0
+4 QUIT 1
