- RMPRPIYR ;HINCIO/ODJ - PIP EDIT - PROMPTS ;3/8/01
- ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
- Q
- ; The following subroutines are for selecting HCPCS
- ; and Inventory Item
- ;
- ;***** OK - Prompt for an OK
- OK(RMPRYN,RMPREXC) ;
- N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
- S RMPREXC=""
- S RMPRYN="N"
- S DIR("A")=" ...OK"
- S DIR("B")="Yes"
- S DIR(0)="Y"
- D ^DIR
- I $D(DTOUT) S RMPREXC="T" G OKX
- I $D(DIROUT) S RMPREXC="P" G OKX
- I X=""!(X["^") S RMPREXC="^" G OKX
- S RMPRYN="N" S:Y RMPRYN="Y"
- OKX Q
- ;
- ;***** PVEN - Prompt for current Stock Record
- PVEN(RMPRSTN,RMPRLCN,RMPRHCPC,RMPRITM,RMPR6,RMPR7,RMPREXC) ;
- N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,DIRUT,RMPRA,RMPRGBLR
- N RMPRMAX,RMPRLIN,RMPRGBL,RMPR7I,RMPRS
- S RMPRERR=0
- S RMPREXC=""
- S RMPRMAX=15
- S RMPRLIN=0
- K RMPR7,RMPR6
- S RMPRLCN=$G(RMPRLCN)
- ;
- ; See if just 1 record - no need to list if there is
- S RMPRGBLR="^RMPR(661.7,""XSHIDS"","_RMPRSTN_","""_RMPRHCPC_""","""_RMPRITM_""")"
- S RMPRGBL=$Q(@RMPRGBLR)
- I $$PVENE() G PVENX
- S RMPR7("IEN")=$QS(RMPRGBL,8)
- S RMPRGBL=$Q(@RMPRGBL)
- I $$PVENE() G PVENG
- ;
- ; Selection list of current stock records
- S RMPRGBL=RMPRGBLR
- PVENL1 S RMPRGBL=$Q(@RMPRGBL)
- I $$PVENE G:'RMPRLIN PVENX G PVENP
- K RMPR7,RMPR7I
- S RMPR7("IEN")=$QS(RMPRGBL,8)
- S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
- S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
- I RMPRLCN'="",RMPRLCN'=RMPR7I("LOCATION") G PVENL1
- I RMPRLIN,'(RMPRLIN#RMPRMAX) D G PVENP
- . S DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, or"
- . Q
- PVENL2 S RMPRLIN=RMPRLIN+1
- I RMPRLIN=1 D PVENH
- S RMPRS=$P(RMPR7I("DATE&TIME"),".",1)
- W !,$J(RMPRLIN,2)," ",$E(RMPRS,4,5)_"/"_$E(RMPRS,6,7)_"/"_$E(RMPRS,2,3)
- W ?11,$J(RMPR7("QUANTITY"),5,0)
- I +RMPR7("QUANTITY") D
- . W ?18,$J(RMPR7("VALUE")/RMPR7("QUANTITY"),8,2)
- . Q
- W ?26,$J(RMPR7("VALUE"),10,2)
- S RMPR6("DATE&TIME")=RMPR7I("DATE&TIME")
- S RMPR6("HCPCS")=RMPRHCPC
- S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
- W ?38,$E(RMPR6("VENDOR"),1,30)
- W ?69,$E(RMPR7("LOCATION"),1,10)
- S RMPRA(RMPRLIN)=RMPR7("IEN")
- K RMPR7,RMPR7I,RMPR6
- G PVENL1
- ;
- ; Prompt for selection
- PVENP S DIR(0)="FAO"
- S DIR("A")="Choose 1 - "_RMPRLIN_" : "
- D ^DIR
- I $D(DTOUT) S RMPREXC="T" G PVENX
- I $D(DIROUT) S RMPREXC="P" G PVENX
- I X="",$D(DIR("A",1)) K DIR("A",1) D PVENH G PVENL2
- I X="" S RMPREXC="^" G PVENX
- I X["^"!($D(DUOUT)) S RMPREXC="^" G PVENX
- I '$D(RMPRA(X)) D G PVENP
- . W !,"Please select a current stock record"
- . W !,"by entering a line number in range 1 - "
- . W RMPRLIN
- . Q
- S RMPR7("IEN")=RMPRA(X)
- PVENG S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
- K RMPR7I
- S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
- S RMPRLCN=RMPR7I("LOCATION")
- S RMPR6("DATE&TIME")=RMPR7I("DATE&TIME")
- S RMPR6("HCPCS")=RMPRHCPC
- S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
- PVENX Q
- PVENE() ;
- Q:$QS(RMPRGBL,1)'=661.7 1
- Q:$QS(RMPRGBL,2)'="XSHIDS" 1
- Q:$QS(RMPRGBL,3)'=RMPRSTN 1
- Q:$QS(RMPRGBL,4)'=RMPRHCPC 1
- Q:$QS(RMPRGBL,5)'=RMPRITM 1
- Q 0
- PVENH W !
- W !,"Select a current stock record...",!
- W ?3,"Date",?13,"Qty",?18,"Unit Cost",?31,"Value",?38,"Vendor"
- I RMPRLCN="" W ?69,"Location"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIYR 3130 printed Feb 19, 2025@00:03:42 Page 2
- RMPRPIYR ;HINCIO/ODJ - PIP EDIT - PROMPTS ;3/8/01
- +1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
- +2 QUIT
- +3 ; The following subroutines are for selecting HCPCS
- +4 ; and Inventory Item
- +5 ;
- +6 ;***** OK - Prompt for an OK
- OK(RMPRYN,RMPREXC) ;
- +1 NEW DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
- +2 SET RMPREXC=""
- +3 SET RMPRYN="N"
- +4 SET DIR("A")=" ...OK"
- +5 SET DIR("B")="Yes"
- +6 SET DIR(0)="Y"
- +7 DO ^DIR
- +8 IF $DATA(DTOUT)
- SET RMPREXC="T"
- GOTO OKX
- +9 IF $DATA(DIROUT)
- SET RMPREXC="P"
- GOTO OKX
- +10 IF X=""!(X["^")
- SET RMPREXC="^"
- GOTO OKX
- +11 SET RMPRYN="N"
- if Y
- SET RMPRYN="Y"
- OKX QUIT
- +1 ;
- +2 ;***** PVEN - Prompt for current Stock Record
- PVEN(RMPRSTN,RMPRLCN,RMPRHCPC,RMPRITM,RMPR6,RMPR7,RMPREXC) ;
- +1 NEW RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,DIRUT,RMPRA,RMPRGBLR
- +2 NEW RMPRMAX,RMPRLIN,RMPRGBL,RMPR7I,RMPRS
- +3 SET RMPRERR=0
- +4 SET RMPREXC=""
- +5 SET RMPRMAX=15
- +6 SET RMPRLIN=0
- +7 KILL RMPR7,RMPR6
- +8 SET RMPRLCN=$GET(RMPRLCN)
- +9 ;
- +10 ; See if just 1 record - no need to list if there is
- +11 SET RMPRGBLR="^RMPR(661.7,""XSHIDS"","_RMPRSTN_","""_RMPRHCPC_""","""_RMPRITM_""")"
- +12 SET RMPRGBL=$QUERY(@RMPRGBLR)
- +13 IF $$PVENE()
- GOTO PVENX
- +14 SET RMPR7("IEN")=$QSUBSCRIPT(RMPRGBL,8)
- +15 SET RMPRGBL=$QUERY(@RMPRGBL)
- +16 IF $$PVENE()
- GOTO PVENG
- +17 ;
- +18 ; Selection list of current stock records
- +19 SET RMPRGBL=RMPRGBLR
- PVENL1 SET RMPRGBL=$QUERY(@RMPRGBL)
- +1 IF $$PVENE
- if 'RMPRLIN
- GOTO PVENX
- GOTO PVENP
- +2 KILL RMPR7,RMPR7I
- +3 SET RMPR7("IEN")=$QSUBSCRIPT(RMPRGBL,8)
- +4 SET RMPRERR=$$GET^RMPRPIX7(.RMPR7)
- +5 SET RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
- +6 IF RMPRLCN'=""
- IF RMPRLCN'=RMPR7I("LOCATION")
- GOTO PVENL1
- +7 IF RMPRLIN
- IF '(RMPRLIN#RMPRMAX)
- Begin DoDot:1
- +8 SET DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, or"
- +9 QUIT
- End DoDot:1
- GOTO PVENP
- PVENL2 SET RMPRLIN=RMPRLIN+1
- +1 IF RMPRLIN=1
- DO PVENH
- +2 SET RMPRS=$PIECE(RMPR7I("DATE&TIME"),".",1)
- +3 WRITE !,$JUSTIFY(RMPRLIN,2)," ",$EXTRACT(RMPRS,4,5)_"/"_$EXTRACT(RMPRS,6,7)_"/"_$EXTRACT(RMPRS,2,3)
- +4 WRITE ?11,$JUSTIFY(RMPR7("QUANTITY"),5,0)
- +5 IF +RMPR7("QUANTITY")
- Begin DoDot:1
- +6 WRITE ?18,$JUSTIFY(RMPR7("VALUE")/RMPR7("QUANTITY"),8,2)
- +7 QUIT
- End DoDot:1
- +8 WRITE ?26,$JUSTIFY(RMPR7("VALUE"),10,2)
- +9 SET RMPR6("DATE&TIME")=RMPR7I("DATE&TIME")
- +10 SET RMPR6("HCPCS")=RMPRHCPC
- +11 SET RMPRERR=$$GET^RMPRPIX6(.RMPR6)
- +12 WRITE ?38,$EXTRACT(RMPR6("VENDOR"),1,30)
- +13 WRITE ?69,$EXTRACT(RMPR7("LOCATION"),1,10)
- +14 SET RMPRA(RMPRLIN)=RMPR7("IEN")
- +15 KILL RMPR7,RMPR7I,RMPR6
- +16 GOTO PVENL1
- +17 ;
- +18 ; Prompt for selection
- PVENP SET DIR(0)="FAO"
- +1 SET DIR("A")="Choose 1 - "_RMPRLIN_" : "
- +2 DO ^DIR
- +3 IF $DATA(DTOUT)
- SET RMPREXC="T"
- GOTO PVENX
- +4 IF $DATA(DIROUT)
- SET RMPREXC="P"
- GOTO PVENX
- +5 IF X=""
- IF $DATA(DIR("A",1))
- KILL DIR("A",1)
- DO PVENH
- GOTO PVENL2
- +6 IF X=""
- SET RMPREXC="^"
- GOTO PVENX
- +7 IF X["^"!($DATA(DUOUT))
- SET RMPREXC="^"
- GOTO PVENX
- +8 IF '$DATA(RMPRA(X))
- Begin DoDot:1
- +9 WRITE !,"Please select a current stock record"
- +10 WRITE !,"by entering a line number in range 1 - "
- +11 WRITE RMPRLIN
- +12 QUIT
- End DoDot:1
- GOTO PVENP
- +13 SET RMPR7("IEN")=RMPRA(X)
- PVENG SET RMPRERR=$$GET^RMPRPIX7(.RMPR7)
- +1 KILL RMPR7I
- +2 SET RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
- +3 SET RMPRLCN=RMPR7I("LOCATION")
- +4 SET RMPR6("DATE&TIME")=RMPR7I("DATE&TIME")
- +5 SET RMPR6("HCPCS")=RMPRHCPC
- +6 SET RMPRERR=$$GET^RMPRPIX6(.RMPR6)
- PVENX QUIT
- PVENE() ;
- +1 if $QSUBSCRIPT(RMPRGBL,1)'=661.7
- QUIT 1
- +2 if $QSUBSCRIPT(RMPRGBL,2)'="XSHIDS"
- QUIT 1
- +3 if $QSUBSCRIPT(RMPRGBL,3)'=RMPRSTN
- QUIT 1
- +4 if $QSUBSCRIPT(RMPRGBL,4)'=RMPRHCPC
- QUIT 1
- +5 if $QSUBSCRIPT(RMPRGBL,5)'=RMPRITM
- QUIT 1
- +6 QUIT 0
- PVENH WRITE !
- +1 WRITE !,"Select a current stock record...",!
- +2 WRITE ?3,"Date",?13,"Qty",?18,"Unit Cost",?31,"Value",?38,"Vendor"
- +3 IF RMPRLCN=""
- WRITE ?69,"Location"
- +4 QUIT