RMPOLM1 ;EDS/MDB - HOME OXYGEN LISTMAN CODE ;7/24/98
;;3.0;PROSTHETICS;**29,64**;Feb 09, 1996
;
; RVD - patch 64 - accept & unaccept all patient billing
; changed PIKSOM TO PIKALL
Q
EN01 ; -- Edit Patient
S RTN="EDIT^RMPOPED"
D COMMON("PIKSOM") K DIR,RTN
Q
COMMON(PIKRTN) ;
D FULL^VALM1
D @PIKRTN Q:$$QUIT I Y="" S VALMBCK="R" Q
S:PIKRTN="PIKONE" Y(0)=Y
M LFNS=Y
S RMJ=0
F RMI=0:0 S RMI=RMI+RMJ,RMJ=1 Q:'$D(LFNS(RMI)) F RMZI=1:1 S RMZ=$P(LFNS(RMI),",",RMZI) Q:RMZ="" D
. S LFN=RMZ
. S RMPODFN=$O(@VALMAR@("IDX",LFN,""))
. D @RTN
S VALMBCK="R"
K LFNS,LFN,PIKRTN,RMI,RMJ,RMZ,RMZI
Q
REDRAW ;
D CLEAN^VALM10,INIT^RMPOLM,RE^VALM4 K DIR
Q
EN02 ; -- Edit Billing Transactions
S RTN="EDIT^RMPOBIL2"
D COMMON("PIKSOM"),REDRAW K RTN
Q
EN03 ; -- Accept Transactions
S RTN="ACCEPT^RMPOBILU"
D COMMON("PIKALL"),REDRAW K RTN
Q
EN04 ; -- Unaccept Transactions
S RTN="UNACCEPT^RMPOBILU"
D COMMON("PIKALL"),REDRAW K RTN
Q
EN09 ; -- QUIK EDIT
S RTN="QUIK^RMPOBIL2"
D COMMON("PIKSOM"),REDRAW K DIR,RTN
Q
EN10 ; -- ADD BILLING PATIENT
D FULL^VALM1 W @IOF D ADD^RMPOBILA H 2
D REDRAW
Q
EN11 ; -- DELETE BILLING PATIENT
S RTN="DEL^RMPOBILA"
D COMMON("PIKSOM"),REDRAW K DIR,RTN
Q
EN06 ; -- Display 2319
S RTN="2319^RMPOBILU"
D COMMON("PIKONE") K DIR,RTN
Q
EN07 ; -- Post Transactions
;
K DFNS
D FULL^VALM1
D PIKSOM Q:$$QUIT I Y="" S VALMBCK="R" Q
S LFNS=Y
F ZI=1:1:$L(LFNS,",")-1 D
. S LFN=$P(LFNS,",",ZI)
. S RMPODFN=$O(@VALMAR@("IDX",LFN,""))
. S DFNS(RMPODFN)=""
D POST^RMPOPST0
D REDRAW
S VALMBCK="R" K DIR,DFNS,RMPODFN,ZI,LFNS,LFN
Q
EN08 ; -- Change View
;
K DIR S DIR(0)="SO^A:Accepted;U:Unaccepted;B:Both"
S DIR("B")="Both"
S DIR("A")="Which Transactions would you like displayed?"
D ^DIR Q:(Y="")!$$QUIT
S DFLAG=Y D REDRAW K DIR
Q
PIKONE ; ALLOW SELECTION OF 1 ENTRY FROM DISPLAYED ENTRIES
K DIR S DIR(0)="NO^"_VALMBG_":"_VALMLST D ^DIR
Q
PIKSOM ; ALLOW SELECTION FROM DISPLAYED ENTRIES
K DIR S DIR(0)="LO^"_VALMBG_":"_VALMLST D ^DIR
Q
PIKALL ; ALLOW SELECTION FROM ALL ENTRIES
K DIR S DIR(0)="LO^1:"_VALMCNT D ^DIR
Q
QUIT() S QUIT=$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q QUIT
EQUIT() S QUIT=$D(DTOUT)!$D(Y) Q QUIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOLM1 2275 printed Apr 09, 2024@21:39:12 Page 2
RMPOLM1 ;EDS/MDB - HOME OXYGEN LISTMAN CODE ;7/24/98
+1 ;;3.0;PROSTHETICS;**29,64**;Feb 09, 1996
+2 ;
+3 ; RVD - patch 64 - accept & unaccept all patient billing
+4 ; changed PIKSOM TO PIKALL
+5 QUIT
EN01 ; -- Edit Patient
+1 SET RTN="EDIT^RMPOPED"
+2 DO COMMON("PIKSOM")
KILL DIR,RTN
+3 QUIT
COMMON(PIKRTN) ;
+1 DO FULL^VALM1
+2 DO @PIKRTN
if $$QUIT
QUIT
IF Y=""
SET VALMBCK="R"
QUIT
+3 if PIKRTN="PIKONE"
SET Y(0)=Y
+4 MERGE LFNS=Y
+5 SET RMJ=0
+6 FOR RMI=0:0
SET RMI=RMI+RMJ
SET RMJ=1
if '$DATA(LFNS(RMI))
QUIT
FOR RMZI=1:1
SET RMZ=$PIECE(LFNS(RMI),",",RMZI)
if RMZ=""
QUIT
Begin DoDot:1
+7 SET LFN=RMZ
+8 SET RMPODFN=$ORDER(@VALMAR@("IDX",LFN,""))
+9 DO @RTN
End DoDot:1
+10 SET VALMBCK="R"
+11 KILL LFNS,LFN,PIKRTN,RMI,RMJ,RMZ,RMZI
+12 QUIT
REDRAW ;
+1 DO CLEAN^VALM10
DO INIT^RMPOLM
DO RE^VALM4
KILL DIR
+2 QUIT
EN02 ; -- Edit Billing Transactions
+1 SET RTN="EDIT^RMPOBIL2"
+2 DO COMMON("PIKSOM")
DO REDRAW
KILL RTN
+3 QUIT
EN03 ; -- Accept Transactions
+1 SET RTN="ACCEPT^RMPOBILU"
+2 DO COMMON("PIKALL")
DO REDRAW
KILL RTN
+3 QUIT
EN04 ; -- Unaccept Transactions
+1 SET RTN="UNACCEPT^RMPOBILU"
+2 DO COMMON("PIKALL")
DO REDRAW
KILL RTN
+3 QUIT
EN09 ; -- QUIK EDIT
+1 SET RTN="QUIK^RMPOBIL2"
+2 DO COMMON("PIKSOM")
DO REDRAW
KILL DIR,RTN
+3 QUIT
EN10 ; -- ADD BILLING PATIENT
+1 DO FULL^VALM1
WRITE @IOF
DO ADD^RMPOBILA
HANG 2
+2 DO REDRAW
+3 QUIT
EN11 ; -- DELETE BILLING PATIENT
+1 SET RTN="DEL^RMPOBILA"
+2 DO COMMON("PIKSOM")
DO REDRAW
KILL DIR,RTN
+3 QUIT
EN06 ; -- Display 2319
+1 SET RTN="2319^RMPOBILU"
+2 DO COMMON("PIKONE")
KILL DIR,RTN
+3 QUIT
EN07 ; -- Post Transactions
+1 ;
+2 KILL DFNS
+3 DO FULL^VALM1
+4 DO PIKSOM
if $$QUIT
QUIT
IF Y=""
SET VALMBCK="R"
QUIT
+5 SET LFNS=Y
+6 FOR ZI=1:1:$LENGTH(LFNS,",")-1
Begin DoDot:1
+7 SET LFN=$PIECE(LFNS,",",ZI)
+8 SET RMPODFN=$ORDER(@VALMAR@("IDX",LFN,""))
+9 SET DFNS(RMPODFN)=""
End DoDot:1
+10 DO POST^RMPOPST0
+11 DO REDRAW
+12 SET VALMBCK="R"
KILL DIR,DFNS,RMPODFN,ZI,LFNS,LFN
+13 QUIT
EN08 ; -- Change View
+1 ;
+2 KILL DIR
SET DIR(0)="SO^A:Accepted;U:Unaccepted;B:Both"
+3 SET DIR("B")="Both"
+4 SET DIR("A")="Which Transactions would you like displayed?"
+5 DO ^DIR
if (Y="")!$$QUIT
QUIT
+6 SET DFLAG=Y
DO REDRAW
KILL DIR
+7 QUIT
PIKONE ; ALLOW SELECTION OF 1 ENTRY FROM DISPLAYED ENTRIES
+1 KILL DIR
SET DIR(0)="NO^"_VALMBG_":"_VALMLST
DO ^DIR
+2 QUIT
PIKSOM ; ALLOW SELECTION FROM DISPLAYED ENTRIES
+1 KILL DIR
SET DIR(0)="LO^"_VALMBG_":"_VALMLST
DO ^DIR
+2 QUIT
PIKALL ; ALLOW SELECTION FROM ALL ENTRIES
+1 KILL DIR
SET DIR(0)="LO^1:"_VALMCNT
DO ^DIR
+2 QUIT
QUIT() SET QUIT=$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT QUIT
EQUIT() SET QUIT=$DATA(DTOUT)!$DATA(Y)
QUIT QUIT
+1 QUIT
