- 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 Feb 18, 2025@23:57:34 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